fpdebug.pas 89 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Debugger call routines 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 FPDebug;
  13. interface
  14. uses
  15. Objects,Dialogs,Drivers,Views,
  16. GDBCon,GDBInt,Menus,
  17. WViews,
  18. FPViews;
  19. type
  20. PDebugController=^TDebugController;
  21. TDebugController=object(TGDBController)
  22. InvalidSourceLine : boolean;
  23. LastFileName : string;
  24. LastSource : PView; {PsourceWindow !! }
  25. HiddenStepsCount : longint;
  26. { no need to switch if using another terminal }
  27. NoSwitch : boolean;
  28. constructor Init(const exefn:string);
  29. destructor Done;
  30. procedure DoSelectSourceline(const fn:string;line:longint);virtual;
  31. { procedure DoStartSession;virtual;
  32. procedure DoBreakSession;virtual;}
  33. procedure DoEndSession(code:longint);virtual;
  34. procedure AnnotateError;
  35. procedure InsertBreakpoints;
  36. procedure RemoveBreakpoints;
  37. procedure ReadWatches;
  38. procedure ResetBreakpointsValues;
  39. procedure DoDebuggerScreen;virtual;
  40. procedure DoUserScreen;virtual;
  41. procedure Reset;virtual;
  42. procedure ResetDebuggerRows;
  43. procedure Run;virtual;
  44. procedure Continue;virtual;
  45. procedure UntilReturn;virtual;
  46. procedure CommandBegin(const s:string);virtual;
  47. procedure CommandEnd(const s:string);virtual;
  48. function AllowQuit : boolean;virtual;
  49. end;
  50. BreakpointType = (bt_function,bt_file_line,bt_watch,bt_awatch,bt_rwatch,bt_invalid);
  51. BreakpointState = (bs_enabled,bs_disabled,bs_deleted);
  52. PBreakpointCollection=^TBreakpointCollection;
  53. PBreakpoint=^TBreakpoint;
  54. TBreakpoint=object(TObject)
  55. typ : BreakpointType;
  56. state : BreakpointState;
  57. owner : PBreakpointCollection;
  58. Name : PString; { either function name or expr to watch }
  59. FileName : PString;
  60. OldValue,CurrentValue : Pstring;
  61. Line : Longint; { only used for bt_file_line type }
  62. Conditions : PString; { conditions relative to that breakpoint }
  63. IgnoreCount : Longint; { how many counts should be ignored }
  64. Commands : pchar; { commands that should be executed on breakpoint }
  65. GDBIndex : longint;
  66. GDBState : BreakpointState;
  67. constructor Init_function(Const AFunc : String);
  68. constructor Init_Empty;
  69. constructor Init_file_line(AFile : String; ALine : longint);
  70. constructor Init_type(atyp : BreakpointType;Const AnExpr : String);
  71. constructor Load(var S: TStream);
  72. procedure Store(var S: TStream);
  73. procedure Insert;
  74. procedure Remove;
  75. procedure Enable;
  76. procedure Disable;
  77. procedure ResetValues;
  78. destructor Done;virtual;
  79. end;
  80. TBreakpointCollection=object(TCollection)
  81. function At(Index: Integer): PBreakpoint;
  82. function GetGDB(index : longint) : PBreakpoint;
  83. function GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  84. function ToggleFileLine(Const FileName: String;LineNr : Longint) : boolean;
  85. procedure Update;
  86. procedure ShowBreakpoints(W : PSourceWindow);
  87. end;
  88. PBreakpointItem = ^TBreakpointItem;
  89. TBreakpointItem = object(TObject)
  90. Breakpoint : PBreakpoint;
  91. constructor Init(ABreakpoint : PBreakpoint);
  92. function GetText(MaxLen: Sw_integer): string; virtual;
  93. procedure Selected; virtual;
  94. function GetModuleName: string; virtual;
  95. end;
  96. PBreakpointsListBox = ^TBreakpointsListBox;
  97. TBreakpointsListBox = object(THSListBox)
  98. Transparent : boolean;
  99. NoSelection : boolean;
  100. MaxWidth : Sw_integer;
  101. (* ModuleNames : PStoreCollection; *)
  102. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  103. procedure AddBreakpoint(P: PBreakpointItem); virtual;
  104. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  105. function GetLocalMenu: PMenu;virtual;
  106. procedure Clear; virtual;
  107. procedure TrackSource; virtual;
  108. procedure EditNew; virtual;
  109. procedure EditCurrent; virtual;
  110. procedure DeleteCurrent; virtual;
  111. procedure ToggleCurrent;
  112. procedure Draw; virtual;
  113. procedure HandleEvent(var Event: TEvent); virtual;
  114. constructor Load(var S: TStream);
  115. procedure Store(var S: TStream);
  116. destructor Done; virtual;
  117. end;
  118. PBreakpointsWindow = ^TBreakpointsWindow;
  119. TBreakpointsWindow = object(TDlgWindow)
  120. BreakLB : PBreakpointsListBox;
  121. constructor Init;
  122. procedure AddBreakpoint(ABreakpoint : PBreakpoint);
  123. procedure ClearBreakpoints;
  124. procedure ReloadBreakpoints;
  125. procedure Close; virtual;
  126. procedure SizeLimits(var Min, Max: TPoint);virtual;
  127. procedure HandleEvent(var Event: TEvent); virtual;
  128. procedure Update; virtual;
  129. constructor Load(var S: TStream);
  130. procedure Store(var S: TStream);
  131. destructor Done; virtual;
  132. end;
  133. PBreakpointItemDialog = ^TBreakpointItemDialog;
  134. TBreakpointItemDialog = object(TCenterDialog)
  135. constructor Init(ABreakpoint: PBreakpoint);
  136. function Execute: Word; virtual;
  137. private
  138. Breakpoint : PBreakpoint;
  139. TypeRB : PRadioButtons;
  140. NameIL : PInputLine;
  141. ConditionsIL: PInputLine;
  142. LineIL : PInputLine;
  143. IgnoreIL : PInputLine;
  144. end;
  145. PWatch = ^TWatch;
  146. TWatch = Object(TObject)
  147. constructor Init(s : string);
  148. constructor Load(var S: TStream);
  149. procedure Store(var S: TStream);
  150. procedure rename(s : string);
  151. procedure Get_new_value;
  152. destructor done;virtual;
  153. private
  154. expr : pstring;
  155. last_value,current_value : pchar;
  156. end;
  157. PWatchesCollection = ^TWatchesCollection;
  158. TWatchesCollection = Object(TCollection)
  159. constructor Init;
  160. procedure Insert(Item: Pointer); virtual;
  161. function At(Index: Integer): PWatch;
  162. procedure Update;
  163. private
  164. MaxW : integer;
  165. end;
  166. PWatchesListBox = ^TWatchesListBox;
  167. TWatchesListBox = object(THSListBox)
  168. Transparent : boolean;
  169. MaxWidth : Sw_integer;
  170. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  171. (* procedure AddWatch(P: PWatch); virtual; *)
  172. procedure Update(AMaxWidth : integer);
  173. function GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String; virtual;
  174. function GetLocalMenu: PMenu;virtual;
  175. (* procedure Clear; virtual;
  176. procedure TrackSource; virtual;*)
  177. procedure EditNew; virtual;
  178. procedure EditCurrent; virtual;
  179. procedure DeleteCurrent; virtual;
  180. (*procedure ToggleCurrent; *)
  181. procedure Draw; virtual;
  182. procedure HandleEvent(var Event: TEvent); virtual;
  183. constructor Load(var S: TStream);
  184. procedure Store(var S: TStream);
  185. destructor Done; virtual;
  186. end;
  187. PWatchItemDialog = ^TWatchItemDialog;
  188. TWatchItemDialog = object(TCenterDialog)
  189. constructor Init(AWatch: PWatch);
  190. function Execute: Word; virtual;
  191. private
  192. Watch : PWatch;
  193. NameIL : PInputLine;
  194. TextST : PAdvancedStaticText;
  195. end;
  196. PWatchesWindow = ^TWatchesWindow;
  197. TWatchesWindow = Object(TDlgWindow)
  198. WLB : PWatchesListBox;
  199. Constructor Init;
  200. constructor Load(var S: TStream);
  201. procedure Store(var S: TStream);
  202. procedure Update; virtual;
  203. destructor Done; virtual;
  204. end;
  205. PFramesListBox = ^TFramesListBox;
  206. TFramesListBox = object(TMessageListBox)
  207. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  208. procedure Update;
  209. function GetLocalMenu: PMenu;virtual;
  210. procedure GotoSource; virtual;
  211. procedure HandleEvent(var Event: TEvent); virtual;
  212. destructor Done; virtual;
  213. end;
  214. PStackWindow = ^TStackWindow;
  215. TStackWindow = Object(TDlgWindow)
  216. FLB : PFramesListBox;
  217. Constructor Init;
  218. constructor Load(var S: TStream);
  219. procedure Store(var S: TStream);
  220. procedure Update; virtual;
  221. destructor Done; virtual;
  222. end;
  223. TIntRegs = record
  224. eax,ebx,ecx,edx,eip,esi,edi,esp,ebp : dword;
  225. cs,ds,es,ss,fs,gs : word;
  226. eflags : dword;
  227. end;
  228. PRegistersView = ^TRegistersView;
  229. TRegistersView = object(TView)
  230. OldReg : TIntRegs;
  231. constructor Init(var Bounds: TRect);
  232. procedure Draw;virtual;
  233. destructor Done; virtual;
  234. end;
  235. PRegistersWindow = ^TRegistersWindow;
  236. TRegistersWindow = Object(TDlgWindow)
  237. RV : PRegistersView;
  238. Constructor Init;
  239. constructor Load(var S: TStream);
  240. procedure Store(var S: TStream);
  241. procedure Update; virtual;
  242. destructor Done; virtual;
  243. end;
  244. TFPURegs = record
  245. end;
  246. PFPUView = ^TFPUView;
  247. TFPUView = object(TView)
  248. OldReg : TFPURegs;
  249. constructor Init(var Bounds: TRect);
  250. procedure Draw;virtual;
  251. destructor Done; virtual;
  252. end;
  253. PFPUWindow = ^TFPUWindow;
  254. TFPUWindow = Object(TDlgWindow)
  255. RV : PFPUView;
  256. Constructor Init;
  257. constructor Load(var S: TStream);
  258. procedure Store(var S: TStream);
  259. procedure Update; virtual;
  260. destructor Done; virtual;
  261. end;
  262. const
  263. StackWindow : PStackWindow = nil;
  264. RegistersWindow : PRegistersWindow = nil;
  265. FPUWindow : PFPUWindow = nil;
  266. procedure InitStackWindow;
  267. procedure DoneStackWindow;
  268. procedure InitRegistersWindow;
  269. procedure DoneRegistersWindow;
  270. function ActiveBreakpoints : boolean;
  271. const
  272. BreakpointTypeStr : Array[BreakpointType] of String[9]
  273. = ( 'function','file-line','watch','awatch','rwatch','invalid' );
  274. BreakpointStateStr : Array[BreakpointState] of String[8]
  275. = ( 'enabled','disabled','invalid' );
  276. DebuggeeTTY : string = '';
  277. var
  278. Debugger : PDebugController;
  279. BreakpointsCollection : PBreakpointCollection;
  280. WatchesCollection : PwatchesCollection;
  281. procedure InitDebugger;
  282. procedure DoneDebugger;
  283. procedure InitGDBWindow;
  284. procedure DoneGDBWindow;
  285. procedure InitBreakpoints;
  286. procedure DoneBreakpoints;
  287. procedure InitWatches;
  288. procedure DoneWatches;
  289. procedure RegisterFPDebugViews;
  290. procedure UpdateDebugViews;
  291. implementation
  292. uses
  293. Dos,Mouse,Video,
  294. App,Commands,Strings,
  295. Systems,
  296. FPVars,FPUtils,FPConst,
  297. FPIntf,FPCompile,FPIde,FPHelp,
  298. Validate,WEditor,WUtils;
  299. const
  300. RBreakpointsWindow: TStreamRec = (
  301. ObjType: 1701;
  302. VmtLink: Ofs(TypeOf(TBreakpointsWindow)^);
  303. Load: @TBreakpointsWindow.Load;
  304. Store: @TBreakpointsWindow.Store
  305. );
  306. RBreakpointsListBox : TStreamRec = (
  307. ObjType: 1702;
  308. VmtLink: Ofs(TypeOf(TBreakpointsListBox)^);
  309. Load: @TBreakpointsListBox.Load;
  310. Store: @TBreakpointsListBox.Store
  311. );
  312. RWatchesWindow: TStreamRec = (
  313. ObjType: 1703;
  314. VmtLink: Ofs(TypeOf(TWatchesWindow)^);
  315. Load: @TWatchesWindow.Load;
  316. Store: @TWatchesWindow.Store
  317. );
  318. RWatchesListBox: TStreamRec = (
  319. ObjType: 1704;
  320. VmtLink: Ofs(TypeOf(TWatchesListBox)^);
  321. Load: @TWatchesListBox.Load;
  322. Store: @TWatchesListBox.Store
  323. );
  324. RStackWindow: TStreamRec = (
  325. ObjType: 1705;
  326. VmtLink: Ofs(TypeOf(TStackWindow)^);
  327. Load: @TStackWindow.Load;
  328. Store: @TStackWindow.Store
  329. );
  330. RFramesListBox: TStreamRec = (
  331. ObjType: 1706;
  332. VmtLink: Ofs(TypeOf(TFramesListBox)^);
  333. Load: @TFramesListBox.Load;
  334. Store: @TFramesListBox.Store
  335. );
  336. RBreakpoint: TStreamRec = (
  337. ObjType: 1707;
  338. VmtLink: Ofs(TypeOf(TBreakpoint)^);
  339. Load: @TBreakpoint.Load;
  340. Store: @TBreakpoint.Store
  341. );
  342. RWatch: TStreamRec = (
  343. ObjType: 1708;
  344. VmtLink: Ofs(TypeOf(TWatch)^);
  345. Load: @TWatch.Load;
  346. Store: @TWatch.Store
  347. );
  348. RBreakpointCollection: TStreamRec = (
  349. ObjType: 1709;
  350. VmtLink: Ofs(TypeOf(TBreakpointCollection)^);
  351. Load: @TBreakpointCollection.Load;
  352. Store: @TBreakpointCollection.Store
  353. );
  354. RWatchesCollection: TStreamRec = (
  355. ObjType: 1710;
  356. VmtLink: Ofs(TypeOf(TWatchesCollection)^);
  357. Load: @TWatchesCollection.Load;
  358. Store: @TWatchesCollection.Store
  359. );
  360. RRegistersWindow: TStreamRec = (
  361. ObjType: 1711;
  362. VmtLink: Ofs(TypeOf(TRegistersWindow)^);
  363. Load: @TRegistersWindow.Load;
  364. Store: @TRegistersWindow.Store
  365. );
  366. RRegistersView: TStreamRec = (
  367. ObjType: 1712;
  368. VmtLink: Ofs(TypeOf(TRegistersView)^);
  369. Load: @TRegistersView.Load;
  370. Store: @TRegistersView.Store
  371. );
  372. RFPUWindow: TStreamRec = (
  373. ObjType: 1713;
  374. VmtLink: Ofs(TypeOf(TFPUWindow)^);
  375. Load: @TFPUWindow.Load;
  376. Store: @TFPUWindow.Store
  377. );
  378. RFPUView: TStreamRec = (
  379. ObjType: 1714;
  380. VmtLink: Ofs(TypeOf(TFPUView)^);
  381. Load: @TFPUView.Load;
  382. Store: @TFPUView.Store
  383. );
  384. {****************************************************************************
  385. TDebugController
  386. ****************************************************************************}
  387. procedure UpdateDebugViews;
  388. begin
  389. If assigned(StackWindow) then
  390. StackWindow^.Update;
  391. If assigned(RegistersWindow) then
  392. RegistersWindow^.Update;
  393. If assigned(Debugger) then
  394. Debugger^.ReadWatches;
  395. If assigned(FPUWindow) then
  396. FPUWindow^.Update;
  397. end;
  398. constructor TDebugController.Init(const exefn:string);
  399. var f: string;
  400. begin
  401. inherited Init;
  402. f := GetShortName(exefn);
  403. NoSwitch:=False;
  404. LoadFile(f);
  405. SetArgs(GetRunParameters);
  406. Debugger:=@self;
  407. {$ifndef GABOR}
  408. switch_to_user:=true;
  409. {$endif}
  410. InsertBreakpoints;
  411. ReadWatches;
  412. end;
  413. procedure TDebugController.InsertBreakpoints;
  414. procedure DoInsert(PB : PBreakpoint);
  415. begin
  416. PB^.Insert;
  417. end;
  418. begin
  419. BreakpointsCollection^.ForEach(@DoInsert);
  420. end;
  421. procedure TDebugController.ReadWatches;
  422. procedure DoRead(PB : PWatch);
  423. begin
  424. PB^.Get_new_value;
  425. end;
  426. begin
  427. WatchesCollection^.ForEach(@DoRead);
  428. If Assigned(WatchesWindow) then
  429. WatchesWindow^.Update;
  430. end;
  431. procedure TDebugController.RemoveBreakpoints;
  432. procedure DoDelete(PB : PBreakpoint);
  433. begin
  434. PB^.Remove;
  435. end;
  436. begin
  437. BreakpointsCollection^.ForEach(@DoDelete);
  438. end;
  439. procedure TDebugController.ResetBreakpointsValues;
  440. procedure DoResetVal(PB : PBreakpoint);
  441. begin
  442. PB^.ResetValues;
  443. end;
  444. begin
  445. BreakpointsCollection^.ForEach(@DoResetVal);
  446. end;
  447. function ActiveBreakpoints : boolean;
  448. var
  449. IsActive : boolean;
  450. procedure TestActive(PB : PBreakpoint);
  451. begin
  452. If PB^.state=bs_enabled then
  453. IsActive:=true;
  454. end;
  455. begin
  456. IsActive:=false;
  457. If assigned(BreakpointsCollection) then
  458. BreakpointsCollection^.ForEach(@TestActive);
  459. ActiveBreakpoints:=IsActive;
  460. end;
  461. destructor TDebugController.Done;
  462. begin
  463. { kill the program if running }
  464. Reset;
  465. RemoveBreakpoints;
  466. inherited Done;
  467. end;
  468. procedure TDebugController.Run;
  469. begin
  470. ResetBreakpointsValues;
  471. {$ifdef win32}
  472. { Run the debugge in another console }
  473. if DebuggeeTTY<>'' then
  474. Command('set new-console on')
  475. else
  476. Command('set new-console off');
  477. NoSwitch:=DebuggeeTTY<>'';
  478. {$endif win32}
  479. {$ifdef linux}
  480. { Run the debugge in another tty }
  481. Command('set tty '+DebuggeeTTY);
  482. NoSwitch:=DebuggeeTTY<>'';
  483. {$endif win32}
  484. { Switch to user screen to get correct handles }
  485. UserScreen;
  486. inherited Run;
  487. DebuggerScreen;
  488. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],true);
  489. UpdateDebugViews;
  490. end;
  491. procedure TDebugController.Continue;
  492. begin
  493. {$ifdef NODEBUG}
  494. NoDebugger;
  495. {$else}
  496. if not debuggee_started then
  497. Run
  498. else
  499. inherited Continue;
  500. UpdateDebugViews;
  501. {$endif NODEBUG}
  502. end;
  503. procedure TDebugController.UntilReturn;
  504. begin
  505. Command('finish');
  506. UpdateDebugViews;
  507. { We could try to get the return value !
  508. Not done yet }
  509. end;
  510. procedure TDebugController.CommandBegin(const s:string);
  511. begin
  512. if assigned(GDBWindow) and (in_command>1) then
  513. begin
  514. { We should do something special for errors !! }
  515. If StrLen(GetError)>0 then
  516. GDBWindow^.WriteErrorText(GetError);
  517. GDBWindow^.WriteOutputText(GetOutput);
  518. end;
  519. if assigned(GDBWindow) then
  520. GDBWindow^.WriteString(S);
  521. end;
  522. procedure TDebugController.CommandEnd(const s:string);
  523. begin
  524. if assigned(GDBWindow) and (in_command=0) then
  525. begin
  526. { We should do something special for errors !! }
  527. If StrLen(GetError)>0 then
  528. GDBWindow^.WriteErrorText(GetError);
  529. GDBWindow^.WriteOutputText(GetOutput);
  530. GDBWindow^.Editor^.TextEnd;
  531. end;
  532. end;
  533. function TDebugController.AllowQuit : boolean;
  534. begin
  535. if ConfirmBox('Really quit editor ?',nil,true)=cmOK then
  536. begin
  537. Message(@IDEApp,evCommand,cmQuit,nil);
  538. end
  539. else
  540. AllowQuit:=false;
  541. end;
  542. procedure TDebugController.ResetDebuggerRows;
  543. procedure ResetDebuggerRow(P: PView); {$ifndef FPC}far;{$endif}
  544. begin
  545. if assigned(P) and
  546. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  547. PSourceWindow(P)^.Editor^.SetDebuggerRow(-1);
  548. end;
  549. begin
  550. Desktop^.ForEach(@ResetDebuggerRow);
  551. end;
  552. procedure TDebugController.Reset;
  553. begin
  554. inherited Reset;
  555. NoSwitch:=false;
  556. IDEApp.SetCmdState([cmResetDebugger,cmUntilReturn],false);
  557. ResetDebuggerRows;
  558. end;
  559. procedure TDebugController.AnnotateError;
  560. var errornb : longint;
  561. begin
  562. if error then
  563. begin
  564. errornb:=error_num;
  565. UpdateDebugViews;
  566. ErrorBox(#3'Error within GDB'#13#3'Error code = %d',@errornb);
  567. end;
  568. end;
  569. procedure TDebugController.DoSelectSourceLine(const fn:string;line:longint);
  570. var
  571. W: PSourceWindow;
  572. Found : boolean;
  573. PB : PBreakpoint;
  574. S : String;
  575. BreakIndex : longint;
  576. begin
  577. BreakIndex:=stop_breakpoint_number;
  578. Desktop^.Lock;
  579. { 0 based line count in Editor }
  580. if Line>0 then
  581. dec(Line);
  582. if (fn=LastFileName) then
  583. begin
  584. W:=PSourceWindow(LastSource);
  585. if assigned(W) then
  586. begin
  587. W^.Editor^.SetCurPtr(0,Line);
  588. W^.Editor^.TrackCursor(true);
  589. W^.Editor^.SetDebuggerRow(Line);
  590. UpdateDebugViews;
  591. if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  592. W^.Select;
  593. InvalidSourceLine:=false;
  594. end
  595. else
  596. InvalidSourceLine:=true;
  597. end
  598. else
  599. begin
  600. W:=TryToOpenFile(nil,fn,0,Line,false);
  601. if assigned(W) then
  602. begin
  603. W^.Editor^.SetDebuggerRow(Line);
  604. W^.Editor^.TrackCursor(true);
  605. UpdateDebugViews;
  606. if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  607. W^.Select;
  608. LastSource:=W;
  609. InvalidSourceLine:=false;
  610. end
  611. { only search a file once }
  612. else
  613. begin
  614. Desktop^.UnLock;
  615. Found:=IDEApp.OpenSearch(fn);
  616. Desktop^.Lock;
  617. if not Found then
  618. begin
  619. InvalidSourceLine:=true;
  620. LastSource:=Nil;
  621. end
  622. else
  623. begin
  624. { should now be open }
  625. W:=TryToOpenFile(nil,fn,0,Line,true);
  626. W^.Editor^.SetDebuggerRow(Line);
  627. W^.Editor^.TrackCursor(true);
  628. UpdateDebugViews;
  629. if Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive) then
  630. W^.Select;
  631. LastSource:=W;
  632. InvalidSourceLine:=false;
  633. end;
  634. end;
  635. end;
  636. LastFileName:=fn;
  637. Desktop^.UnLock;
  638. if BreakIndex>0 then
  639. begin
  640. PB:=BreakpointsCollection^.GetGDB(BreakIndex);
  641. { For watch we should get old and new value !! }
  642. if (Not assigned(GDBWindow) or not GDBWindow^.GetState(sfActive)) and
  643. (PB^.typ<>bt_file_line) and (PB^.typ<>bt_function) then
  644. begin
  645. Command('p '+GetStr(PB^.Name));
  646. S:=GetPChar(GetOutput);
  647. got_error:=false;
  648. If Pos('=',S)>0 then
  649. S:=Copy(S,Pos('=',S)+1,255);
  650. If S[Length(S)]=#10 then
  651. Delete(S,Length(S),1);
  652. if Assigned(PB^.OldValue) then
  653. DisposeStr(PB^.OldValue);
  654. PB^.OldValue:=PB^.CurrentValue;
  655. PB^.CurrentValue:=NewStr(S);
  656. If PB^.typ=bt_function then
  657. WarningBox(#3'GDB stopped due to'#13+
  658. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name),nil)
  659. else if (GetStr(PB^.OldValue)<>S) then
  660. WarningBox(#3'GDB stopped due to'#13+
  661. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  662. #3+'Old value = '+GetStr(PB^.OldValue)+#13+
  663. #3+'New value = '+GetStr(PB^.CurrentValue),nil)
  664. else
  665. WarningBox(#3'GDB stopped due to'#13+
  666. #3+BreakpointTypeStr[PB^.typ]+' '+GetStr(PB^.Name)+#13+
  667. #3+' value = '+GetStr(PB^.CurrentValue),nil);
  668. end;
  669. end;
  670. end;
  671. procedure TDebugController.DoEndSession(code:longint);
  672. var P :Array[1..2] of longint;
  673. W : PSourceWindow;
  674. begin
  675. IDEApp.SetCmdState([cmResetDebugger],false);
  676. ResetDebuggerRows;
  677. LastExitCode:=Code;
  678. If HiddenStepsCount=0 then
  679. InformationBox(#3'Program exited with '#13#3'exitcode = %d',@code)
  680. else
  681. begin
  682. P[1]:=code;
  683. P[2]:=HiddenStepsCount;
  684. WarningBox(#3'Program exited with '#13+
  685. #3'exitcode = %d'#13+
  686. #3'hidden steps = %d',@P);
  687. end;
  688. end;
  689. procedure TDebugController.DoDebuggerScreen;
  690. begin
  691. if NoSwitch then
  692. PopStatus
  693. else
  694. IDEApp.ShowIDEScreen;
  695. end;
  696. procedure TDebugController.DoUserScreen;
  697. begin
  698. if NoSwitch then
  699. PushStatus('Executable running in another window..')
  700. else
  701. IDEApp.ShowUserScreen;
  702. end;
  703. {****************************************************************************
  704. TBreakpoint
  705. ****************************************************************************}
  706. constructor TBreakpoint.Init_function(Const AFunc : String);
  707. begin
  708. typ:=bt_function;
  709. state:=bs_enabled;
  710. GDBState:=bs_deleted;
  711. Name:=NewStr(AFunc);
  712. FileName:=nil;
  713. Line:=0;
  714. IgnoreCount:=0;
  715. Commands:=nil;
  716. Conditions:=nil;
  717. OldValue:=nil;
  718. CurrentValue:=nil;
  719. end;
  720. constructor TBreakpoint.Init_Empty;
  721. begin
  722. typ:=bt_function;
  723. state:=bs_enabled;
  724. GDBState:=bs_deleted;
  725. Name:=Nil;
  726. FileName:=nil;
  727. Line:=0;
  728. IgnoreCount:=0;
  729. Commands:=nil;
  730. Conditions:=nil;
  731. OldValue:=nil;
  732. CurrentValue:=nil;
  733. end;
  734. constructor TBreakpoint.Init_type(atyp : BreakpointType;Const AnExpr : String);
  735. begin
  736. typ:=atyp;
  737. state:=bs_enabled;
  738. GDBState:=bs_deleted;
  739. Name:=NewStr(AnExpr);
  740. IgnoreCount:=0;
  741. Commands:=nil;
  742. Conditions:=nil;
  743. OldValue:=nil;
  744. CurrentValue:=nil;
  745. end;
  746. constructor TBreakpoint.Init_file_line(AFile : String; ALine : longint);
  747. begin
  748. typ:=bt_file_line;
  749. state:=bs_enabled;
  750. GDBState:=bs_deleted;
  751. { d:test.pas:12 does not work !! }
  752. { I do not know how to solve this if
  753. if (Length(AFile)>1) and (AFile[2]=':') then
  754. AFile:=Copy(AFile,3,255);
  755. Only use base name for now !! PM }
  756. FileName:=NewStr(AFile);
  757. Name:=nil;
  758. Line:=ALine;
  759. IgnoreCount:=0;
  760. Commands:=nil;
  761. Conditions:=nil;
  762. OldValue:=nil;
  763. CurrentValue:=nil;
  764. end;
  765. constructor TBreakpoint.Load(var S: TStream);
  766. begin
  767. S.Read(typ,SizeOf(BreakpointType));
  768. S.Read(state,SizeOf(BreakpointState));
  769. GDBState:=bs_deleted;
  770. case typ of
  771. bt_file_line :
  772. begin
  773. FileName:=S.ReadStr;
  774. S.Read(Line,SizeOf(Line));
  775. Name:=nil;
  776. end;
  777. else
  778. begin
  779. Name:=S.ReadStr;
  780. Line:=0;
  781. FileName:=nil;
  782. end;
  783. end;
  784. S.Read(IgnoreCount,SizeOf(IgnoreCount));
  785. Commands:=S.StrRead;
  786. Conditions:=S.ReadStr;
  787. OldValue:=nil;
  788. CurrentValue:=nil;
  789. end;
  790. procedure TBreakpoint.Store(var S: TStream);
  791. begin
  792. S.Write(typ,SizeOf(BreakpointType));
  793. S.Write(state,SizeOf(BreakpointState));
  794. case typ of
  795. bt_file_line :
  796. begin
  797. S.WriteStr(FileName);
  798. S.Write(Line,SizeOf(Line));
  799. end;
  800. else
  801. begin
  802. S.WriteStr(Name);
  803. end;
  804. end;
  805. S.Write(IgnoreCount,SizeOf(IgnoreCount));
  806. S.StrWrite(Commands);
  807. S.WriteStr(Conditions);
  808. end;
  809. procedure TBreakpoint.Insert;
  810. begin
  811. If not assigned(Debugger) then Exit;
  812. Remove;
  813. Debugger^.last_breakpoint_number:=0;
  814. if (GDBState=bs_deleted) and (state=bs_enabled) then
  815. begin
  816. if (typ=bt_file_line) and assigned(FileName) then
  817. Debugger^.Command('break '+NameAndExtOf(FileName^)+':'+IntToStr(Line))
  818. else if (typ=bt_function) and assigned(name) then
  819. Debugger^.Command('break '+name^)
  820. else if (typ=bt_watch) and assigned(name) then
  821. Debugger^.Command('watch '+name^)
  822. else if (typ=bt_awatch) and assigned(name) then
  823. Debugger^.Command('awatch '+name^)
  824. else if (typ=bt_rwatch) and assigned(name) then
  825. Debugger^.Command('rwatch '+name^);
  826. if Debugger^.last_breakpoint_number<>0 then
  827. begin
  828. GDBIndex:=Debugger^.last_breakpoint_number;
  829. GDBState:=bs_enabled;
  830. Debugger^.Command('cond '+IntToStr(GDBIndex)+' '+GetStr(Conditions));
  831. If IgnoreCount>0 then
  832. Debugger^.Command('ignore '+IntToStr(GDBIndex)+' '+IntToStr(IgnoreCount));
  833. If Assigned(Commands) then
  834. begin
  835. {Commands are not handled yet }
  836. end;
  837. end
  838. else
  839. { Here there was a problem !! }
  840. begin
  841. GDBIndex:=0;
  842. ErrorBox(#3'Could not set Breakpoint'#13+
  843. #3+BreakpointTypeStr[typ]+' '+GetStr(Name),nil);
  844. state:=bs_disabled;
  845. end;
  846. end
  847. else if (GDBState=bs_disabled) and (state=bs_enabled) then
  848. Enable
  849. else if (GDBState=bs_enabled) and (state=bs_disabled) then
  850. Disable;
  851. end;
  852. procedure TBreakpoint.Remove;
  853. begin
  854. If not assigned(Debugger) then Exit;
  855. if GDBIndex>0 then
  856. Debugger^.Command('delete '+IntToStr(GDBIndex));
  857. GDBIndex:=0;
  858. GDBState:=bs_deleted;
  859. end;
  860. procedure TBreakpoint.Enable;
  861. begin
  862. If not assigned(Debugger) then Exit;
  863. if GDBIndex>0 then
  864. Debugger^.Command('enable '+IntToStr(GDBIndex))
  865. else
  866. Insert;
  867. GDBState:=bs_enabled;
  868. end;
  869. procedure TBreakpoint.Disable;
  870. begin
  871. If not assigned(Debugger) then Exit;
  872. if GDBIndex>0 then
  873. Debugger^.Command('disable '+IntToStr(GDBIndex));
  874. GDBState:=bs_disabled;
  875. end;
  876. procedure TBreakpoint.ResetValues;
  877. begin
  878. if assigned(OldValue) then
  879. DisposeStr(OldValue);
  880. OldValue:=nil;
  881. if assigned(CurrentValue) then
  882. DisposeStr(CurrentValue);
  883. CurrentValue:=nil;
  884. end;
  885. destructor TBreakpoint.Done;
  886. begin
  887. Remove;
  888. ResetValues;
  889. if assigned(Name) then
  890. DisposeStr(Name);
  891. if assigned(FileName) then
  892. DisposeStr(FileName);
  893. if assigned(Conditions) then
  894. DisposeStr(Conditions);
  895. if assigned(Commands) then
  896. StrDispose(Commands);
  897. inherited Done;
  898. end;
  899. {****************************************************************************
  900. TBreakpointCollection
  901. ****************************************************************************}
  902. function TBreakpointCollection.At(Index: Integer): PBreakpoint;
  903. begin
  904. At:=inherited At(Index);
  905. end;
  906. procedure TBreakpointCollection.Update;
  907. begin
  908. if assigned(Debugger) then
  909. begin
  910. Debugger^.RemoveBreakpoints;
  911. Debugger^.InsertBreakpoints;
  912. end;
  913. if assigned(BreakpointsWindow) then
  914. BreakpointsWindow^.Update;
  915. end;
  916. function TBreakpointCollection.GetGDB(index : longint) : PBreakpoint;
  917. function IsNum(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  918. begin
  919. IsNum:=P^.GDBIndex=index;
  920. end;
  921. begin
  922. if index=0 then
  923. GetGDB:=nil
  924. else
  925. GetGDB:=FirstThat(@IsNum);
  926. end;
  927. procedure TBreakpointCollection.ShowBreakpoints(W : PSourceWindow);
  928. procedure SetInSource(P : PBreakpoint);{$ifndef FPC}far;{$endif}
  929. begin
  930. If assigned(P^.FileName) and (P^.FileName^=W^.Editor^.FileName) then
  931. W^.Editor^.SetLineBreakState(P^.Line,P^.state=bs_enabled);
  932. end;
  933. begin
  934. ForEach(@SetInSource);
  935. end;
  936. function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
  937. function IsThis(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  938. begin
  939. IsThis:=(P^.typ=typ) and (GetStr(P^.Name)=S);
  940. end;
  941. begin
  942. GetType:=FirstThat(@IsThis);
  943. end;
  944. function TBreakpointCollection.ToggleFileLine(Const FileName: String;LineNr : Longint) : boolean;
  945. var PB : PBreakpoint;
  946. function IsThere(P : PBreakpoint) : boolean;{$ifndef FPC}far;{$endif}
  947. begin
  948. IsThere:=(P^.typ=bt_file_line) and (P^.FileName^=FileName) and (P^.Line=LineNr);
  949. end;
  950. begin
  951. PB:=FirstThat(@IsThere);
  952. ToggleFileLine:=false;
  953. If Assigned(PB) then
  954. if PB^.state=bs_disabled then
  955. begin
  956. PB^.state:=bs_enabled;
  957. ToggleFileLine:=true;
  958. end
  959. else if PB^.state=bs_enabled then
  960. PB^.state:=bs_disabled;
  961. If not assigned(PB) then
  962. begin
  963. PB:= New(PBreakpoint,Init_file_line(FileName,LineNr));
  964. if assigned(PB) then
  965. Begin
  966. Insert(PB);
  967. ToggleFileLine:=true;
  968. End;
  969. end;
  970. Update;
  971. end;
  972. {****************************************************************************
  973. TBreakpointItem
  974. ****************************************************************************}
  975. constructor TBreakpointItem.Init(ABreakpoint : PBreakpoint);
  976. begin
  977. inherited Init;
  978. Breakpoint:=ABreakpoint;
  979. end;
  980. function TBreakpointItem.GetText(MaxLen: Sw_integer): string;
  981. var S: string;
  982. begin
  983. with Breakpoint^ do
  984. begin
  985. S:=BreakpointTypeStr[typ];
  986. While Length(S)<10 do
  987. S:=S+' ';
  988. S:=S+'|';
  989. S:=S+BreakpointStateStr[state]+' ';
  990. While Length(S)<20 do
  991. S:=S+' ';
  992. S:=S+'|';
  993. if (typ=bt_file_line) then
  994. S:=S+NameAndExtOf(GetStr(FileName))+':'+IntToStr(Line)
  995. else
  996. S:=S+GetStr(name);
  997. While Length(S)<40 do
  998. S:=S+' ';
  999. S:=S+'|';
  1000. if IgnoreCount>0 then
  1001. S:=S+IntToStr(IgnoreCount);
  1002. While Length(S)<49 do
  1003. S:=S+' ';
  1004. S:=S+'|';
  1005. if assigned(Conditions) then
  1006. S:=S+' '+GetStr(Conditions);
  1007. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1008. GetText:=S;
  1009. end;
  1010. end;
  1011. procedure TBreakpointItem.Selected;
  1012. begin
  1013. end;
  1014. function TBreakpointItem.GetModuleName: string;
  1015. begin
  1016. if breakpoint^.typ=bt_file_line then
  1017. GetModuleName:=GetStr(breakpoint^.FileName)
  1018. else
  1019. GetModuleName:='';
  1020. end;
  1021. {****************************************************************************
  1022. TBreakpointsListBox
  1023. ****************************************************************************}
  1024. constructor TBreakpointsListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1025. begin
  1026. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1027. GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1028. NoSelection:=true;
  1029. end;
  1030. function TBreakpointsListBox.GetLocalMenu: PMenu;
  1031. var M: PMenu;
  1032. begin
  1033. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1034. M:=NewMenu(
  1035. NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1036. NewItem('~E~dit breakpoint','',kbNoKey,cmEditBreakpoint,hcEditBreakpoint,
  1037. NewItem('~N~ew breakpoint','',kbNoKey,cmNewBreakpoint,hcNewBreakpoint,
  1038. NewItem('~D~elete breakpoint','',kbNoKey,cmDeleteBreakpoint,hcDeleteBreakpoint,
  1039. NewItem('~T~oggle state','',kbNoKey,cmToggleBreakpoint,hcToggleBreakpoint,
  1040. nil))))));
  1041. GetLocalMenu:=M;
  1042. end;
  1043. procedure TBreakpointsListBox.HandleEvent(var Event: TEvent);
  1044. var DontClear: boolean;
  1045. begin
  1046. case Event.What of
  1047. evKeyDown :
  1048. begin
  1049. DontClear:=false;
  1050. case Event.KeyCode of
  1051. kbEnter :
  1052. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1053. else
  1054. DontClear:=true;
  1055. end;
  1056. if not DontClear then
  1057. ClearEvent(Event);
  1058. end;
  1059. evBroadcast :
  1060. case Event.Command of
  1061. cmListItemSelected :
  1062. if Event.InfoPtr=@Self then
  1063. Message(@Self,evCommand,cmEditBreakpoint,nil);
  1064. end;
  1065. evCommand :
  1066. begin
  1067. DontClear:=false;
  1068. case Event.Command of
  1069. cmMsgTrackSource :
  1070. if Range>0 then
  1071. TrackSource;
  1072. cmEditBreakpoint :
  1073. EditCurrent;
  1074. cmToggleBreakpoint :
  1075. ToggleCurrent;
  1076. cmDeleteBreakpoint :
  1077. DeleteCurrent;
  1078. cmNewBreakpoint :
  1079. EditNew;
  1080. cmMsgClear :
  1081. Clear;
  1082. else
  1083. DontClear:=true;
  1084. end;
  1085. if not DontClear then
  1086. ClearEvent(Event);
  1087. end;
  1088. end;
  1089. inherited HandleEvent(Event);
  1090. end;
  1091. procedure TBreakpointsListBox.AddBreakpoint(P: PBreakpointItem);
  1092. var W : integer;
  1093. begin
  1094. if List=nil then New(List, Init(20,20));
  1095. W:=length(P^.GetText(255));
  1096. if W>MaxWidth then
  1097. begin
  1098. MaxWidth:=W;
  1099. if HScrollBar<>nil then
  1100. HScrollBar^.SetRange(0,MaxWidth);
  1101. end;
  1102. List^.Insert(P);
  1103. SetRange(List^.Count);
  1104. if Focused=List^.Count-1-1 then
  1105. FocusItem(List^.Count-1);
  1106. DrawView;
  1107. end;
  1108. (* function TBreakpointsListBox.AddModuleName(const Name: string): PString;
  1109. var P: PString;
  1110. begin
  1111. if ModuleNames<>nil then
  1112. P:=ModuleNames^.Add(Name)
  1113. else
  1114. P:=nil;
  1115. AddModuleName:=P;
  1116. end; *)
  1117. function TBreakpointsListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1118. var P: PBreakpointItem;
  1119. S: string;
  1120. begin
  1121. P:=List^.At(Item);
  1122. S:=P^.GetText(MaxLen);
  1123. GetText:=copy(S,1,MaxLen);
  1124. end;
  1125. procedure TBreakpointsListBox.Clear;
  1126. begin
  1127. if assigned(List) then
  1128. Dispose(List, Done);
  1129. List:=nil;
  1130. MaxWidth:=0;
  1131. (* if assigned(ModuleNames) then
  1132. ModuleNames^.FreeAll; *)
  1133. SetRange(0); DrawView;
  1134. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1135. end;
  1136. procedure TBreakpointsListBox.TrackSource;
  1137. var W: PSourceWindow;
  1138. P: PBreakpointItem;
  1139. R: TRect;
  1140. (* Row,Col: sw_integer; *)
  1141. begin
  1142. (*Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1143. if Range=0 then Exit;*)
  1144. P:=List^.At(Focused);
  1145. if P^.GetModuleName='' then Exit;
  1146. Desktop^.Lock;
  1147. GetNextEditorBounds(R);
  1148. R.B.Y:=Owner^.Origin.Y;
  1149. W:=EditorWindowFile(P^.GetModuleName);
  1150. if assigned(W) then
  1151. begin
  1152. W^.GetExtent(R);
  1153. R.B.Y:=Owner^.Origin.Y;
  1154. W^.ChangeBounds(R);
  1155. W^.Editor^.SetCurPtr(1,P^.Breakpoint^.Line);
  1156. end
  1157. else
  1158. W:=TryToOpenFile(@R,P^.GetModuleName,1,P^.Breakpoint^.Line,true);
  1159. if W<>nil then
  1160. begin
  1161. W^.Select;
  1162. W^.Editor^.TrackCursor(true);
  1163. W^.Editor^.SetHighlightRow(P^.Breakpoint^.Line);
  1164. end;
  1165. if Assigned(Owner) then
  1166. Owner^.Select;
  1167. Desktop^.UnLock;
  1168. end;
  1169. procedure TBreakpointsListBox.ToggleCurrent;
  1170. var W: PSourceWindow;
  1171. P: PBreakpointItem;
  1172. b : boolean;
  1173. (* Row,Col: sw_integer; *)
  1174. begin
  1175. if Range=0 then Exit;
  1176. P:=List^.At(Focused);
  1177. if P=nil then Exit;
  1178. if P^.Breakpoint^.state=bs_enabled then
  1179. P^.Breakpoint^.state:=bs_disabled
  1180. else if P^.Breakpoint^.state=bs_disabled then
  1181. P^.Breakpoint^.state:=bs_enabled;
  1182. BreakpointsCollection^.Update;
  1183. if P^.Breakpoint^.typ=bt_file_line then
  1184. begin
  1185. W:=TryToOpenFile(nil,GetStr(P^.Breakpoint^.FileName),1,P^.Breakpoint^.Line,false);
  1186. If assigned(W) then
  1187. begin
  1188. if P^.Breakpoint^.state=bs_enabled then
  1189. b:=true
  1190. else
  1191. b:=false;
  1192. W^.Editor^.SetLineBreakState(P^.Breakpoint^.Line,b);
  1193. end;
  1194. end;
  1195. end;
  1196. procedure TBreakpointsListBox.EditCurrent;
  1197. var
  1198. P: PBreakpointItem;
  1199. begin
  1200. if Range=0 then Exit;
  1201. P:=List^.At(Focused);
  1202. if P=nil then Exit;
  1203. Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P^.Breakpoint)),nil);
  1204. BreakpointsCollection^.Update;
  1205. end;
  1206. procedure TBreakpointsListBox.DeleteCurrent;
  1207. var
  1208. P: PBreakpointItem;
  1209. begin
  1210. if Range=0 then Exit;
  1211. P:=List^.At(Focused);
  1212. if P=nil then Exit;
  1213. BreakpointsCollection^.free(P^.Breakpoint);
  1214. List^.free(P);
  1215. BreakpointsCollection^.Update;
  1216. end;
  1217. procedure TBreakpointsListBox.EditNew;
  1218. var
  1219. P: PBreakpoint;
  1220. begin
  1221. P:=New(PBreakpoint,Init_Empty);
  1222. if Application^.ExecuteDialog(New(PBreakpointItemDialog,Init(P)),nil)<>cmCancel then
  1223. begin
  1224. BreakpointsCollection^.Insert(P);
  1225. BreakpointsCollection^.Update;
  1226. end
  1227. else
  1228. dispose(P,Done);
  1229. end;
  1230. procedure TBreakpointsListBox.Draw;
  1231. var
  1232. I, J, Item: Sw_Integer;
  1233. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1234. ColWidth, CurCol, Indent: Integer;
  1235. B: TDrawBuffer;
  1236. Text: String;
  1237. SCOff: Byte;
  1238. TC: byte;
  1239. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1240. begin
  1241. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1242. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1243. begin
  1244. NormalColor := GetColor(1);
  1245. FocusedColor := GetColor(3);
  1246. SelectedColor := GetColor(4);
  1247. end else
  1248. begin
  1249. NormalColor := GetColor(2);
  1250. SelectedColor := GetColor(4);
  1251. end;
  1252. if Transparent then
  1253. begin MT(NormalColor); MT(SelectedColor); end;
  1254. if NoSelection then
  1255. SelectedColor:=NormalColor;
  1256. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1257. else Indent := 0;
  1258. ColWidth := Size.X div NumCols + 1;
  1259. for I := 0 to Size.Y - 1 do
  1260. begin
  1261. for J := 0 to NumCols-1 do
  1262. begin
  1263. Item := J*Size.Y + I + TopItem;
  1264. CurCol := J*ColWidth;
  1265. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1266. (Focused = Item) and (Range > 0) then
  1267. begin
  1268. Color := FocusedColor;
  1269. SetCursor(CurCol+1,I);
  1270. SCOff := 0;
  1271. end
  1272. else if (Item < Range) and IsSelected(Item) then
  1273. begin
  1274. Color := SelectedColor;
  1275. SCOff := 2;
  1276. end
  1277. else
  1278. begin
  1279. Color := NormalColor;
  1280. SCOff := 4;
  1281. end;
  1282. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1283. if Item < Range then
  1284. begin
  1285. Text := GetText(Item, ColWidth + Indent);
  1286. Text := Copy(Text,Indent,ColWidth);
  1287. MoveStr(B[CurCol+1], Text, Color);
  1288. if ShowMarkers then
  1289. begin
  1290. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1291. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1292. end;
  1293. end;
  1294. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1295. end;
  1296. WriteLine(0, I, Size.X, 1, B);
  1297. end;
  1298. end;
  1299. constructor TBreakpointsListBox.Load(var S: TStream);
  1300. begin
  1301. inherited Load(S);
  1302. end;
  1303. procedure TBreakpointsListBox.Store(var S: TStream);
  1304. var OL: PCollection;
  1305. OldR : integer;
  1306. begin
  1307. OL:=List;
  1308. OldR:=Range;
  1309. Range:=0;
  1310. New(List, Init(1,1));
  1311. inherited Store(S);
  1312. Dispose(List, Done);
  1313. Range:=OldR;
  1314. List:=OL;
  1315. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1316. collection? Pasting here a modified version of TListBox.Store+
  1317. TAdvancedListBox.Store isn't a better solution, since by eventually
  1318. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1319. end;
  1320. destructor TBreakpointsListBox.Done;
  1321. begin
  1322. inherited Done;
  1323. if List<>nil then Dispose(List, Done);
  1324. (* if ModuleNames<>nil then Dispose(ModuleNames, Done);*)
  1325. end;
  1326. {****************************************************************************
  1327. TBreakpointsWindow
  1328. ****************************************************************************}
  1329. constructor TBreakpointsWindow.Init;
  1330. var R,R2: TRect;
  1331. HSB,VSB: PScrollBar;
  1332. ST: PStaticText;
  1333. S: String;
  1334. X,X1 : Sw_integer;
  1335. const White = 15;
  1336. begin
  1337. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-18;
  1338. inherited Init(R, 'Breakpoint list', wnNoNumber);
  1339. HelpCtx:=hcBreakpointListWindow;
  1340. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+1;
  1341. S:=' Type | State | Position | Ignore | Conditions ';
  1342. New(ST, Init(R,S));
  1343. ST^.GrowMode:=gfGrowHiX;
  1344. Insert(ST);
  1345. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,1); R.B.Y:=R.A.Y+1;
  1346. New(ST, Init(R, CharStr('Ä', MaxViewWidth)));
  1347. ST^.GrowMode:=gfGrowHiX;
  1348. Insert(ST);
  1349. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,2);Dec(R.B.Y,5);
  1350. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1351. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1352. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1353. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1354. New(BreakLB, Init(R,HSB,VSB));
  1355. BreakLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1356. BreakLB^.Transparent:=true;
  1357. Insert(BreakLB);
  1358. GetExtent(R);R.Grow(-1,-1);
  1359. Dec(R.B.Y);
  1360. R.A.Y:=R.B.Y-2;
  1361. X:=(R.B.X-R.A.X) div 4;
  1362. X1:=R.A.X+(X div 2);
  1363. R.A.X:=X1-3;R.B.X:=X1+7;
  1364. Insert(New(PButton, Init(R, '~C~lose', cmClose, bfDefault)));
  1365. X1:=X1+X;
  1366. R.A.X:=X1-3;R.B.X:=X1+7;
  1367. Insert(New(PButton, Init(R, '~N~ew', cmNewBreakpoint, bfNormal)));
  1368. X1:=X1+X;
  1369. R.A.X:=X1-3;R.B.X:=X1+7;
  1370. Insert(New(PButton, Init(R, '~E~dit', cmEditBreakpoint, bfNormal)));
  1371. X1:=X1+X;
  1372. R.A.X:=X1-3;R.B.X:=X1+7;
  1373. Insert(New(PButton, Init(R, '~D~elete', cmDeleteBreakpoint, bfNormal)));
  1374. BreakLB^.Select;
  1375. Update;
  1376. BreakpointsWindow:=@self;
  1377. end;
  1378. constructor TBreakpointsWindow.Load(var S: TStream);
  1379. begin
  1380. inherited Load(S);
  1381. GetSubViewPtr(S,BreakLB);
  1382. end;
  1383. procedure TBreakpointsWindow.Store(var S: TStream);
  1384. begin
  1385. inherited Store(S);
  1386. PutSubViewPtr(S,BreakLB);
  1387. end;
  1388. procedure TBreakpointsWindow.AddBreakpoint(ABreakpoint : PBreakpoint);
  1389. begin
  1390. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(ABreakpoint)));
  1391. end;
  1392. procedure TBreakpointsWindow.ClearBreakpoints;
  1393. begin
  1394. BreakLB^.Clear;
  1395. ReDraw;
  1396. end;
  1397. procedure TBreakpointsWindow.ReloadBreakpoints;
  1398. procedure InsertInBreakLB(P : PBreakpoint);
  1399. begin
  1400. BreakLB^.AddBreakpoint(New(PBreakpointItem, Init(P)));
  1401. end;
  1402. begin
  1403. If not assigned(BreakpointsCollection) then
  1404. exit;
  1405. BreakpointsCollection^.ForEach(@InsertInBreakLB);
  1406. ReDraw;
  1407. end;
  1408. procedure TBreakpointsWindow.SizeLimits(var Min, Max: TPoint);
  1409. begin
  1410. inherited SizeLimits(Min,Max);
  1411. Min.X:=40; Min.Y:=18;
  1412. end;
  1413. procedure TBreakpointsWindow.Close;
  1414. begin
  1415. Hide;
  1416. end;
  1417. procedure TBreakpointsWindow.HandleEvent(var Event: TEvent);
  1418. var DontClear : boolean;
  1419. begin
  1420. case Event.What of
  1421. evKeyDown :
  1422. begin
  1423. if (Event.KeyCode=kbEnter) or (Event.KeyCode=kbEsc) then
  1424. begin
  1425. ClearEvent(Event);
  1426. Hide;
  1427. end;
  1428. end;
  1429. evCommand :
  1430. begin
  1431. DontClear:=False;
  1432. case Event.Command of
  1433. cmNewBreakpoint :
  1434. BreakLB^.EditNew;
  1435. cmEditBreakpoint :
  1436. BreakLB^.EditCurrent;
  1437. cmDeleteBreakpoint :
  1438. BreakLB^.DeleteCurrent;
  1439. cmClose :
  1440. Hide;
  1441. else
  1442. DontClear:=true;
  1443. end;
  1444. if not DontClear then
  1445. ClearEvent(Event);
  1446. end;
  1447. evBroadcast :
  1448. case Event.Command of
  1449. cmUpdate :
  1450. Update;
  1451. end;
  1452. end;
  1453. inherited HandleEvent(Event);
  1454. end;
  1455. procedure TBreakpointsWindow.Update;
  1456. begin
  1457. ClearBreakpoints;
  1458. ReloadBreakpoints;
  1459. end;
  1460. destructor TBreakpointsWindow.Done;
  1461. begin
  1462. inherited Done;
  1463. BreakpointsWindow:=nil;
  1464. end;
  1465. {****************************************************************************
  1466. TBreakpointItemDialog
  1467. ****************************************************************************}
  1468. constructor TBreakpointItemDialog.Init(ABreakpoint: PBreakpoint);
  1469. var R,R2,R3: TRect;
  1470. Items: PSItem;
  1471. I : BreakpointType;
  1472. KeyCount: sw_integer;
  1473. begin
  1474. KeyCount:=longint(high(BreakpointType));
  1475. R.Assign(0,0,60,Max(3+KeyCount,18));
  1476. inherited Init(R,'Modify/New Breakpoint');
  1477. Breakpoint:=ABreakpoint;
  1478. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  1479. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  1480. New(NameIL, Init(R, 128)); Insert(NameIL);
  1481. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~N~ame', NameIL)));
  1482. R.Move(0,3);
  1483. New(LineIL, Init(R, 128)); Insert(LineIL);
  1484. LineIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1485. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~L~ine', LineIL)));
  1486. R.Move(0,3);
  1487. New(ConditionsIL, Init(R, 128)); Insert(ConditionsIL);
  1488. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, 'Conditions', ConditionsIL)));
  1489. R.Move(0,3);
  1490. New(IgnoreIL, Init(R, 128)); Insert(IgnoreIL);
  1491. IgnoreIL^.SetValidator(New(PRangeValidator, Init(0,MaxInt)));
  1492. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~I~gnore count', IgnoreIL)));
  1493. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  1494. Items:=nil;
  1495. for I:=high(BreakpointType) downto low(BreakpointType) do
  1496. Items:=NewSItem(BreakpointTypeStr[I], Items);
  1497. New(TypeRB, Init(R, Items));
  1498. Insert(TypeRB);
  1499. InsertButtons(@Self);
  1500. NameIL^.Select;
  1501. end;
  1502. function TBreakpointItemDialog.Execute: Word;
  1503. var R: word;
  1504. S1: string;
  1505. err: word;
  1506. L: longint;
  1507. begin
  1508. R:=longint(Breakpoint^.typ);
  1509. TypeRB^.SetData(R);
  1510. If Breakpoint^.typ=bt_file_line then
  1511. S1:=GetStr(Breakpoint^.FileName)
  1512. else
  1513. S1:=GetStr(Breakpoint^.name);
  1514. NameIL^.SetData(S1);
  1515. If Breakpoint^.typ=bt_file_line then
  1516. S1:=IntToStr(Breakpoint^.Line)
  1517. else
  1518. S1:='0';
  1519. LineIL^.SetData(S1);
  1520. S1:=IntToStr(Breakpoint^.IgnoreCount);
  1521. IgnoreIL^.SetData(S1);
  1522. S1:=GetStr(Breakpoint^.Conditions);
  1523. ConditionsIL^.SetData(S1);
  1524. R:=inherited Execute;
  1525. if R=cmOK then
  1526. begin
  1527. TypeRB^.GetData(R);
  1528. L:=R;
  1529. Breakpoint^.typ:=BreakpointType(L);
  1530. NameIL^.GetData(S1);
  1531. If Breakpoint^.typ=bt_file_line then
  1532. begin
  1533. If assigned(Breakpoint^.FileName) then
  1534. DisposeStr(Breakpoint^.FileName);
  1535. Breakpoint^.FileName:=NewStr(S1);
  1536. end
  1537. else
  1538. begin
  1539. If assigned(Breakpoint^.Name) then
  1540. DisposeStr(Breakpoint^.Name);
  1541. Breakpoint^.name:=NewStr(S1);
  1542. end;
  1543. If Breakpoint^.typ=bt_file_line then
  1544. begin
  1545. LineIL^.GetData(S1);
  1546. Val(S1,L,err);
  1547. Breakpoint^.Line:=L;
  1548. end;
  1549. IgnoreIL^.GetData(S1);
  1550. Val(S1,L,err);
  1551. Breakpoint^.IgnoreCount:=L;
  1552. ConditionsIL^.GetData(S1);
  1553. If assigned(Breakpoint^.Conditions) then
  1554. DisposeStr(Breakpoint^.Conditions);
  1555. Breakpoint^.Conditions:=NewStr(S1);
  1556. end;
  1557. Execute:=R;
  1558. end;
  1559. {****************************************************************************
  1560. TWatch
  1561. ****************************************************************************}
  1562. constructor TWatch.Init(s : string);
  1563. begin
  1564. expr:=NewStr(s);
  1565. last_value:=nil;
  1566. current_value:=nil;
  1567. Get_new_value;
  1568. end;
  1569. constructor TWatch.Load(var S: TStream);
  1570. begin
  1571. expr:=S.ReadStr;
  1572. last_value:=nil;
  1573. current_value:=nil;
  1574. Get_new_value;
  1575. end;
  1576. procedure TWatch.Store(var S: TStream);
  1577. begin
  1578. S.WriteStr(expr);
  1579. end;
  1580. procedure TWatch.rename(s : string);
  1581. begin
  1582. if assigned(expr) then
  1583. begin
  1584. if GetStr(expr)=S then
  1585. exit;
  1586. DisposeStr(expr);
  1587. end;
  1588. expr:=NewStr(s);
  1589. if assigned(last_value) then
  1590. StrDispose(last_value);
  1591. last_value:=nil;
  1592. if assigned(current_value) then
  1593. StrDispose(current_value);
  1594. current_value:=nil;
  1595. Get_new_value;
  1596. end;
  1597. procedure TWatch.Get_new_value;
  1598. var p,q : pchar;
  1599. i : longint;
  1600. last_removed : boolean;
  1601. begin
  1602. If not assigned(Debugger) then
  1603. exit;
  1604. if assigned(last_value) then
  1605. strdispose(last_value);
  1606. last_value:=current_value;
  1607. Debugger^.Command('p '+GetStr(expr));
  1608. if Debugger^.Error then
  1609. p:=StrNew(Debugger^.GetError)
  1610. else
  1611. p:=StrNew(Debugger^.GetOutput);
  1612. { do not open a messagebox for such errors }
  1613. Debugger^.got_error:=false;
  1614. q:=nil;
  1615. if assigned(p) and (p[0]='$') then
  1616. q:=StrPos(p,'=');
  1617. if not assigned(q) then
  1618. q:=p;
  1619. if assigned(q) then
  1620. i:=strlen(q)
  1621. else
  1622. i:=0;
  1623. if (i>0) and (q[i-1]=#10) then
  1624. begin
  1625. q[i-1]:=#0;
  1626. last_removed:=true;
  1627. end
  1628. else
  1629. last_removed:=false;
  1630. if assigned(q) then
  1631. current_value:=strnew(q)
  1632. else
  1633. current_value:=strnew('');
  1634. if last_removed then
  1635. q[i-1]:=#10;
  1636. strdispose(p);
  1637. end;
  1638. destructor TWatch.Done;
  1639. begin
  1640. if assigned(expr) then
  1641. disposestr(expr);
  1642. if assigned(last_value) then
  1643. strdispose(last_value);
  1644. if assigned(current_value) then
  1645. strdispose(current_value);
  1646. inherited done;
  1647. end;
  1648. {****************************************************************************
  1649. TWatchesCollection
  1650. ****************************************************************************}
  1651. constructor TWatchesCollection.Init;
  1652. begin
  1653. inherited Init(10,10);
  1654. end;
  1655. procedure TWatchesCollection.Insert(Item: Pointer);
  1656. begin
  1657. PWatch(Item)^.Get_new_value;
  1658. Inherited Insert(Item);
  1659. Update;
  1660. end;
  1661. procedure TWatchesCollection.Update;
  1662. var
  1663. W,W1 : integer;
  1664. procedure GetMax(P : PWatch);
  1665. begin
  1666. if assigned(P^.Current_value) then
  1667. begin
  1668. W1:=StrLen(P^.Current_value)+2+Length(GetStr(P^.expr));
  1669. if W1>W then
  1670. W:=W1;
  1671. end;
  1672. end;
  1673. begin
  1674. W:=0;
  1675. ForEach(@GetMax);
  1676. MaxW:=W;
  1677. If assigned(WatchesWindow) then
  1678. WatchesWindow^.WLB^.Update(MaxW);
  1679. end;
  1680. function TWatchesCollection.At(Index: Integer): PWatch;
  1681. begin
  1682. At:=Inherited At(Index);
  1683. end;
  1684. {****************************************************************************
  1685. TWatchesListBox
  1686. ****************************************************************************}
  1687. constructor TWatchesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1688. begin
  1689. inherited Init(Bounds,1,AHScrollBar,AVScrollBar);
  1690. If assigned(List) then
  1691. dispose(list,done);
  1692. List:=WatchesCollection;
  1693. end;
  1694. procedure TWatchesListBox.Update(AMaxWidth : integer);
  1695. var R : TRect;
  1696. begin
  1697. GetExtent(R);
  1698. MaxWidth:=AMaxWidth;
  1699. if HScrollBar<>nil then
  1700. HScrollBar^.SetRange(0,MaxWidth);
  1701. if R.B.X-R.A.X>MaxWidth then
  1702. HScrollBar^.Hide
  1703. else
  1704. HScrollBar^.Show;
  1705. SetRange(List^.Count);
  1706. if R.B.Y-R.A.Y>Range then
  1707. VScrollBar^.Hide
  1708. else
  1709. VScrollBar^.Show;
  1710. if Focused=List^.Count-1-1 then
  1711. FocusItem(List^.Count-1);
  1712. DrawView;
  1713. end;
  1714. function TWatchesListBox.GetIndentedText(Item,Indent,MaxLen: Sw_Integer): String;
  1715. var
  1716. PW : PWatch;
  1717. ValOffset : Sw_integer;
  1718. S : String;
  1719. begin
  1720. PW:=WatchesCollection^.At(Item);
  1721. ValOffset:=Length(GetStr(PW^.Expr))+2;
  1722. if Indent<ValOffset then
  1723. begin
  1724. if not assigned(PW^.current_value) then
  1725. S:=' '+GetStr(PW^.Expr)+' <Unknown value>'
  1726. else if not assigned(PW^.last_value) or
  1727. (strcomp(PW^.Last_value,PW^.Current_value)=0) then
  1728. S:=' '+GetStr(PW^.Expr)+' '+GetPChar(PW^.Current_value)
  1729. else
  1730. S:='!'+GetStr(PW^.Expr)+'!'+GetPchar(PW^.Current_value);
  1731. GetIndentedText:=Copy(S,Indent,MaxLen);
  1732. end
  1733. else
  1734. begin
  1735. if not assigned(PW^.Current_value) or
  1736. (StrLen(PW^.Current_value)<Indent-Valoffset) then
  1737. S:=''
  1738. else
  1739. S:=GetStr(@(PW^.Current_Value[Indent-Valoffset]));
  1740. GetIndentedText:=Copy(S,1,MaxLen);
  1741. end;
  1742. end;
  1743. procedure TWatchesListBox.EditCurrent;
  1744. var
  1745. P: PWatch;
  1746. begin
  1747. if Range=0 then Exit;
  1748. P:=WatchesCollection^.At(Focused);
  1749. if P=nil then Exit;
  1750. Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil);
  1751. WatchesCollection^.Update;
  1752. end;
  1753. procedure TWatchesListBox.DeleteCurrent;
  1754. var
  1755. P: PWatch;
  1756. begin
  1757. if Range=0 then Exit;
  1758. P:=WatchesCollection^.At(Focused);
  1759. if P=nil then Exit;
  1760. WatchesCollection^.free(P);
  1761. WatchesCollection^.Update;
  1762. end;
  1763. procedure TWatchesListBox.EditNew;
  1764. var
  1765. P: PWatch;
  1766. begin
  1767. P:=New(PWatch,Init(''));
  1768. if Application^.ExecuteDialog(New(PWatchItemDialog,Init(P)),nil)<>cmCancel then
  1769. begin
  1770. WatchesCollection^.Insert(P);
  1771. WatchesCollection^.Update;
  1772. end
  1773. else
  1774. dispose(P,Done);
  1775. end;
  1776. procedure TWatchesListBox.Draw;
  1777. var
  1778. I, J, Item: Sw_Integer;
  1779. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1780. ColWidth, CurCol, Indent: Integer;
  1781. B: TDrawBuffer;
  1782. Text: String;
  1783. SCOff: Byte;
  1784. TC: byte;
  1785. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1786. begin
  1787. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1788. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1789. begin
  1790. NormalColor := GetColor(1);
  1791. FocusedColor := GetColor(3);
  1792. SelectedColor := GetColor(4);
  1793. end else
  1794. begin
  1795. NormalColor := GetColor(2);
  1796. SelectedColor := GetColor(4);
  1797. end;
  1798. if Transparent then
  1799. begin MT(NormalColor); MT(SelectedColor); end;
  1800. (* if NoSelection then
  1801. SelectedColor:=NormalColor;*)
  1802. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1803. else Indent := 0;
  1804. ColWidth := Size.X div NumCols + 1;
  1805. for I := 0 to Size.Y - 1 do
  1806. begin
  1807. for J := 0 to NumCols-1 do
  1808. begin
  1809. Item := J*Size.Y + I + TopItem;
  1810. CurCol := J*ColWidth;
  1811. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1812. (Focused = Item) and (Range > 0) then
  1813. begin
  1814. Color := FocusedColor;
  1815. SetCursor(CurCol+1,I);
  1816. SCOff := 0;
  1817. end
  1818. else if (Item < Range) and IsSelected(Item) then
  1819. begin
  1820. Color := SelectedColor;
  1821. SCOff := 2;
  1822. end
  1823. else
  1824. begin
  1825. Color := NormalColor;
  1826. SCOff := 4;
  1827. end;
  1828. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1829. if Item < Range then
  1830. begin
  1831. (* Text := GetText(Item, ColWidth + Indent);
  1832. Text := Copy(Text,Indent,ColWidth); *)
  1833. Text:=GetIndentedText(Item,Indent,ColWidth);
  1834. MoveStr(B[CurCol+1], Text, Color);
  1835. if ShowMarkers then
  1836. begin
  1837. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1838. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1839. end;
  1840. end;
  1841. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1842. end;
  1843. WriteLine(0, I, Size.X, 1, B);
  1844. end;
  1845. end;
  1846. function TWatchesListBox.GetLocalMenu: PMenu;
  1847. var M: PMenu;
  1848. begin
  1849. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1850. M:=NewMenu(
  1851. NewItem('~E~dit watch','',kbNoKey,cmEdit,hcNoContext,
  1852. NewItem('~N~ew watch','',kbNoKey,cmNew,hcNoContext,
  1853. NewItem('~D~elete watch','',kbNoKey,cmDelete,hcNoContext,
  1854. nil))));
  1855. GetLocalMenu:=M;
  1856. end;
  1857. procedure TWatchesListBox.HandleEvent(var Event: TEvent);
  1858. var DontClear: boolean;
  1859. begin
  1860. case Event.What of
  1861. evKeyDown :
  1862. begin
  1863. DontClear:=false;
  1864. case Event.KeyCode of
  1865. kbEnter :
  1866. Message(@Self,evCommand,cmEdit,nil);
  1867. kbIns :
  1868. Message(@Self,evCommand,cmNew,nil);
  1869. kbDel :
  1870. Message(@Self,evCommand,cmDelete,nil);
  1871. else
  1872. DontClear:=true;
  1873. end;
  1874. if not DontClear then
  1875. ClearEvent(Event);
  1876. end;
  1877. evBroadcast :
  1878. case Event.Command of
  1879. cmListItemSelected :
  1880. if Event.InfoPtr=@Self then
  1881. Message(@Self,evCommand,cmEdit,nil);
  1882. end;
  1883. evCommand :
  1884. begin
  1885. DontClear:=false;
  1886. case Event.Command of
  1887. cmEdit :
  1888. EditCurrent;
  1889. cmDelete :
  1890. DeleteCurrent;
  1891. cmNew :
  1892. EditNew;
  1893. else
  1894. DontClear:=true;
  1895. end;
  1896. if not DontClear then
  1897. ClearEvent(Event);
  1898. end;
  1899. end;
  1900. inherited HandleEvent(Event);
  1901. end;
  1902. constructor TWatchesListBox.Load(var S: TStream);
  1903. begin
  1904. inherited Load(S);
  1905. If assigned(List) then
  1906. dispose(list,done);
  1907. List:=WatchesCollection;
  1908. { we must set Range PM }
  1909. SetRange(List^.count);
  1910. end;
  1911. procedure TWatchesListBox.Store(var S: TStream);
  1912. var OL: PCollection;
  1913. OldRange : Sw_integer;
  1914. begin
  1915. OL:=List;
  1916. OldRange:=Range;
  1917. Range:=0;
  1918. New(List, Init(1,1));
  1919. inherited Store(S);
  1920. Dispose(List, Done);
  1921. List:=OL;
  1922. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1923. collection? Pasting here a modified version of TListBox.Store+
  1924. TAdvancedListBox.Store isn't a better solution, since by eventually
  1925. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1926. SetRange(OldRange);
  1927. end;
  1928. destructor TWatchesListBox.Done;
  1929. begin
  1930. List:=nil;
  1931. inherited Done;
  1932. end;
  1933. {****************************************************************************
  1934. TWatchesWindow
  1935. ****************************************************************************}
  1936. Constructor TWatchesWindow.Init;
  1937. var
  1938. HSB,VSB: PScrollBar;
  1939. R,R2 : trect;
  1940. begin
  1941. Desktop^.GetExtent(R);
  1942. R.A.Y:=R.B.Y-5;
  1943. inherited Init(R, 'Watches', wnNoNumber);
  1944. Palette:=wpCyanWindow;
  1945. GetExtent(R);
  1946. HelpCtx:=hcWatches;
  1947. R.Grow(-1,-1);
  1948. R2.Copy(R);
  1949. Inc(R2.B.Y);
  1950. R2.A.Y:=R2.B.Y-1;
  1951. New(HSB, Init(R2));
  1952. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  1953. Insert(HSB);
  1954. R2.Copy(R);
  1955. Inc(R2.B.X);
  1956. R2.A.X:=R2.B.X-1;
  1957. New(VSB, Init(R2));
  1958. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  1959. Insert(VSB);
  1960. New(WLB,Init(R,HSB,VSB));
  1961. WLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1962. WLB^.Transparent:=true;
  1963. Insert(WLB);
  1964. If assigned(WatchesWindow) then
  1965. dispose(WatchesWindow,done);
  1966. WatchesWindow:=@Self;
  1967. Update;
  1968. end;
  1969. procedure TWatchesWindow.Update;
  1970. begin
  1971. WatchesCollection^.Update;
  1972. Draw;
  1973. end;
  1974. constructor TWatchesWindow.Load(var S: TStream);
  1975. begin
  1976. inherited Load(S);
  1977. GetSubViewPtr(S,WLB);
  1978. If assigned(WatchesWindow) then
  1979. dispose(WatchesWindow,done);
  1980. WatchesWindow:=@Self;
  1981. end;
  1982. procedure TWatchesWindow.Store(var S: TStream);
  1983. begin
  1984. inherited Store(S);
  1985. PutSubViewPtr(S,WLB);
  1986. end;
  1987. Destructor TWatchesWindow.Done;
  1988. begin
  1989. WatchesWindow:=nil;
  1990. Dispose(WLB,done);
  1991. inherited done;
  1992. end;
  1993. {****************************************************************************
  1994. TWatchItemDialog
  1995. ****************************************************************************}
  1996. constructor TWatchItemDialog.Init(AWatch: PWatch);
  1997. var R,R2: TRect;
  1998. begin
  1999. R.Assign(0,0,50,10);
  2000. inherited Init(R,'Edit Watch');
  2001. Watch:=AWatch;
  2002. GetExtent(R); R.Grow(-3,-2);
  2003. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  2004. New(NameIL, Init(R, 255)); Insert(NameIL);
  2005. R2.Copy(R); R2.Move(-1,-1);
  2006. Insert(New(PLabel, Init(R2, '~E~xpression to watch', NameIL)));
  2007. GetExtent(R);
  2008. R.Grow(-1,-1);
  2009. R.A.Y:=R.A.Y+3;
  2010. R.B.X:=R.A.X+36;
  2011. TextST:=New(PAdvancedStaticText, Init(R, 'Watch values'));
  2012. Insert(TextST);
  2013. InsertButtons(@Self);
  2014. NameIL^.Select;
  2015. end;
  2016. function TWatchItemDialog.Execute: Word;
  2017. var R: word;
  2018. S1,S2: string;
  2019. begin
  2020. S1:=GetStr(Watch^.expr);
  2021. NameIL^.SetData(S1);
  2022. if assigned(Watch^.Current_value) then
  2023. S1:=GetPChar(Watch^.Current_value)
  2024. else
  2025. S1:='';
  2026. if assigned(Watch^.Last_value) then
  2027. S2:=GetPChar(Watch^.Last_value)
  2028. else
  2029. S2:='';
  2030. if assigned(Watch^.Last_value) and
  2031. assigned(Watch^.Current_value) and
  2032. (strcomp(Watch^.Last_value,Watch^.Current_value)=0) then
  2033. S1:='Current value: '+#13+S1
  2034. else
  2035. S1:='Current value: '+#13+S1+#13+
  2036. 'Previous value: '+#13+S2;
  2037. TextST^.SetText(S1);
  2038. R:=inherited Execute;
  2039. if R=cmOK then
  2040. begin
  2041. NameIL^.GetData(S1);
  2042. Watch^.Rename(S1);
  2043. If assigned(Debugger) then
  2044. Debugger^.ReadWatches;
  2045. end;
  2046. Execute:=R;
  2047. end;
  2048. {****************************************************************************
  2049. TRegistersView
  2050. ****************************************************************************}
  2051. function GetIntRegs(var rs : TIntRegs) : boolean;
  2052. var
  2053. p,po : pchar;
  2054. p1 : pchar;
  2055. reg,value : string;
  2056. buffer : array[0..255] of char;
  2057. v : dword;
  2058. code : word;
  2059. begin
  2060. GetIntRegs:=false;
  2061. {$ifndef NODEBUG}
  2062. Debugger^.Command('info registers');
  2063. if Debugger^.Error then
  2064. exit
  2065. else
  2066. begin
  2067. po:=StrNew(Debugger^.GetOutput);
  2068. p:=po;
  2069. if assigned(p) then
  2070. begin
  2071. fillchar(rs,sizeof(rs),0);
  2072. p1:=strscan(p,' ');
  2073. while assigned(p1) do
  2074. begin
  2075. strlcopy(buffer,p,p1-p);
  2076. reg:=strpas(buffer);
  2077. p:=strscan(p,'$');
  2078. p1:=strscan(p,#9);
  2079. strlcopy(buffer,p,p1-p);
  2080. value:=strpas(buffer);
  2081. val(value,v,code);
  2082. if reg='eax' then
  2083. rs.eax:=v
  2084. else if reg='ebx' then
  2085. rs.ebx:=v
  2086. else if reg='ecx' then
  2087. rs.ecx:=v
  2088. else if reg='edx' then
  2089. rs.edx:=v
  2090. else if reg='eip' then
  2091. rs.eip:=v
  2092. else if reg='esi' then
  2093. rs.esi:=v
  2094. else if reg='edi' then
  2095. rs.edi:=v
  2096. else if reg='esp' then
  2097. rs.esp:=v
  2098. else if reg='ebp' then
  2099. rs.ebp:=v
  2100. { under win32 flags are on a register named ps !! PM }
  2101. else if (reg='eflags') or (reg='ps') then
  2102. rs.eflags:=v
  2103. else if reg='cs' then
  2104. rs.cs:=v
  2105. else if reg='ds' then
  2106. rs.ds:=v
  2107. else if reg='es' then
  2108. rs.es:=v
  2109. else if reg='fs' then
  2110. rs.fs:=v
  2111. else if reg='gs' then
  2112. rs.gs:=v
  2113. else if reg='ss' then
  2114. rs.ss:=v;
  2115. p:=strscan(p1,#10);
  2116. if assigned(p) then
  2117. begin
  2118. p1:=strscan(p,' ');
  2119. inc(p);
  2120. end
  2121. else
  2122. break;
  2123. end;
  2124. { free allocated memory }
  2125. strdispose(po);
  2126. end
  2127. else
  2128. exit;
  2129. end;
  2130. { do not open a messagebox for such errors }
  2131. Debugger^.got_error:=false;
  2132. GetIntRegs:=true;
  2133. {$endif}
  2134. end;
  2135. constructor TRegistersView.Init(var Bounds: TRect);
  2136. begin
  2137. inherited init(Bounds);
  2138. end;
  2139. procedure TRegistersView.Draw;
  2140. var
  2141. rs : tintregs;
  2142. color :byte;
  2143. procedure SetColor(x,y : longint);
  2144. begin
  2145. if x=y then
  2146. color:=7
  2147. else
  2148. color:=8;
  2149. end;
  2150. begin
  2151. inherited draw;
  2152. If not assigned(Debugger) then
  2153. begin
  2154. WriteStr(1,0,'<no values available>',7);
  2155. exit;
  2156. end;
  2157. if GetIntRegs(rs) then
  2158. begin
  2159. SetColor(rs.eax,OldReg.eax);
  2160. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2161. SetColor(rs.ebx,OldReg.ebx);
  2162. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2163. SetColor(rs.ecx,OldReg.ecx);
  2164. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2165. SetColor(rs.edx,OldReg.edx);
  2166. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2167. SetColor(rs.eip,OldReg.eip);
  2168. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2169. SetColor(rs.esi,OldReg.esi);
  2170. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2171. SetColor(rs.edi,OldReg.edi);
  2172. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2173. SetColor(rs.esp,OldReg.esp);
  2174. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2175. SetColor(rs.ebp,OldReg.ebp);
  2176. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2177. SetColor(rs.cs,OldReg.cs);
  2178. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2179. SetColor(rs.ds,OldReg.ds);
  2180. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2181. SetColor(rs.es,OldReg.es);
  2182. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2183. SetColor(rs.fs,OldReg.fs);
  2184. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2185. SetColor(rs.gs,OldReg.gs);
  2186. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2187. SetColor(rs.ss,OldReg.ss);
  2188. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2189. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2190. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2191. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2192. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2193. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2194. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2195. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2196. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2197. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2198. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2199. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2200. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2201. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2202. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2203. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2204. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2205. OldReg:=rs;
  2206. end
  2207. else
  2208. WriteStr(0,0,'<debugger error>',7);
  2209. end;
  2210. destructor TRegistersView.Done;
  2211. begin
  2212. inherited done;
  2213. end;
  2214. {****************************************************************************
  2215. TRegistersWindow
  2216. ****************************************************************************}
  2217. constructor TRegistersWindow.Init;
  2218. var
  2219. R : TRect;
  2220. begin
  2221. Desktop^.GetExtent(R);
  2222. R.A.X:=R.B.X-28;
  2223. R.B.Y:=R.A.Y+11;
  2224. inherited Init(R,'Register View', wnNoNumber);
  2225. Flags:=wfClose or wfMove;
  2226. Palette:=wpCyanWindow;
  2227. HelpCtx:=hcRegisters;
  2228. R.Assign(1,1,26,10);
  2229. RV:=new(PRegistersView,init(R));
  2230. Insert(RV);
  2231. If assigned(RegistersWindow) then
  2232. dispose(RegistersWindow,done);
  2233. RegistersWindow:=@Self;
  2234. Update;
  2235. end;
  2236. constructor TRegistersWindow.Load(var S: TStream);
  2237. begin
  2238. inherited load(S);
  2239. GetSubViewPtr(S,RV);
  2240. If assigned(RegistersWindow) then
  2241. dispose(RegistersWindow,done);
  2242. RegistersWindow:=@Self;
  2243. end;
  2244. procedure TRegistersWindow.Store(var S: TStream);
  2245. begin
  2246. inherited Store(s);
  2247. PutSubViewPtr(S,RV);
  2248. end;
  2249. procedure TRegistersWindow.Update;
  2250. begin
  2251. ReDraw;
  2252. end;
  2253. destructor TRegistersWindow.Done;
  2254. begin
  2255. RegistersWindow:=nil;
  2256. inherited done;
  2257. end;
  2258. {****************************************************************************
  2259. TFPUView
  2260. ****************************************************************************}
  2261. function GetFPURegs(var rs : TFPURegs) : boolean;
  2262. var
  2263. p,po : pchar;
  2264. p1 : pchar;
  2265. reg,value : string;
  2266. buffer : array[0..255] of char;
  2267. v : dword;
  2268. code : word;
  2269. begin
  2270. GetFPURegs:=false;
  2271. {$ifndef NODEBUG}
  2272. Debugger^.Command('info registers');
  2273. if Debugger^.Error then
  2274. exit
  2275. else
  2276. begin
  2277. po:=StrNew(Debugger^.GetOutput);
  2278. p:=po;
  2279. if assigned(p) then
  2280. begin
  2281. fillchar(rs,sizeof(rs),0);
  2282. p1:=strscan(p,' ');
  2283. while assigned(p1) do
  2284. begin
  2285. {
  2286. strlcopy(buffer,p,p1-p);
  2287. reg:=strpas(buffer);
  2288. p:=strscan(p,'$');
  2289. p1:=strscan(p,#9);
  2290. strlcopy(buffer,p,p1-p);
  2291. value:=strpas(buffer);
  2292. val(value,v,code);
  2293. if reg='eax' then
  2294. rs.eax:=v
  2295. else if reg='ebx' then
  2296. rs.ebx:=v
  2297. else if reg='ecx' then
  2298. rs.ecx:=v
  2299. else if reg='edx' then
  2300. rs.edx:=v
  2301. else if reg='eip' then
  2302. rs.eip:=v
  2303. else if reg='esi' then
  2304. rs.esi:=v
  2305. else if reg='edi' then
  2306. rs.edi:=v
  2307. else if reg='esp' then
  2308. rs.esp:=v
  2309. else if reg='ebp' then
  2310. rs.ebp:=v
  2311. { under win32 flags are on a register named ps !! PM }
  2312. else if (reg='eflags') or (reg='ps') then
  2313. rs.eflags:=v
  2314. else if reg='cs' then
  2315. rs.cs:=v
  2316. else if reg='ds' then
  2317. rs.ds:=v
  2318. else if reg='es' then
  2319. rs.es:=v
  2320. else if reg='fs' then
  2321. rs.fs:=v
  2322. else if reg='gs' then
  2323. rs.gs:=v
  2324. else if reg='ss' then
  2325. rs.ss:=v;
  2326. p:=strscan(p1,#10);
  2327. if assigned(p) then
  2328. begin
  2329. p1:=strscan(p,' ');
  2330. inc(p);
  2331. end
  2332. else
  2333. break;
  2334. }
  2335. end;
  2336. { free allocated memory }
  2337. strdispose(po);
  2338. end
  2339. else
  2340. exit;
  2341. end;
  2342. { do not open a messagebox for such errors }
  2343. Debugger^.got_error:=false;
  2344. GetFPURegs:=true;
  2345. {$endif}
  2346. end;
  2347. constructor TFPUView.Init(var Bounds: TRect);
  2348. begin
  2349. inherited init(Bounds);
  2350. end;
  2351. procedure TFPUView.Draw;
  2352. var
  2353. rs : tfpuregs;
  2354. color :byte;
  2355. procedure SetColor(x,y : longint);
  2356. begin
  2357. if x=y then
  2358. color:=7
  2359. else
  2360. color:=8;
  2361. end;
  2362. begin
  2363. inherited draw;
  2364. If not assigned(Debugger) then
  2365. begin
  2366. WriteStr(1,0,'<no values available>',7);
  2367. exit;
  2368. end;
  2369. if GetFPURegs(rs) then
  2370. begin
  2371. {
  2372. SetColor(rs.eax,OldReg.eax);
  2373. WriteStr(1,0,'EAX '+HexStr(rs.eax,8),color);
  2374. SetColor(rs.ebx,OldReg.ebx);
  2375. WriteStr(1,1,'EBX '+HexStr(rs.ebx,8),color);
  2376. SetColor(rs.ecx,OldReg.ecx);
  2377. WriteStr(1,2,'ECX '+HexStr(rs.ecx,8),color);
  2378. SetColor(rs.edx,OldReg.edx);
  2379. WriteStr(1,3,'EDX '+HexStr(rs.edx,8),color);
  2380. SetColor(rs.eip,OldReg.eip);
  2381. WriteStr(1,4,'EIP '+HexStr(rs.eip,8),color);
  2382. SetColor(rs.esi,OldReg.esi);
  2383. WriteStr(1,5,'ESI '+HexStr(rs.esi,8),color);
  2384. SetColor(rs.edi,OldReg.edi);
  2385. WriteStr(1,6,'EDI '+HexStr(rs.edi,8),color);
  2386. SetColor(rs.esp,OldReg.esp);
  2387. WriteStr(1,7,'ESP '+HexStr(rs.esp,8),color);
  2388. SetColor(rs.ebp,OldReg.ebp);
  2389. WriteStr(1,8,'EBP '+HexStr(rs.ebp,8),color);
  2390. SetColor(rs.cs,OldReg.cs);
  2391. WriteStr(14,0,'CS '+HexStr(rs.cs,4),color);
  2392. SetColor(rs.ds,OldReg.ds);
  2393. WriteStr(14,1,'DS '+HexStr(rs.ds,4),color);
  2394. SetColor(rs.es,OldReg.es);
  2395. WriteStr(14,2,'ES '+HexStr(rs.es,4),color);
  2396. SetColor(rs.fs,OldReg.fs);
  2397. WriteStr(14,3,'FS '+HexStr(rs.fs,4),color);
  2398. SetColor(rs.gs,OldReg.gs);
  2399. WriteStr(14,4,'GS '+HexStr(rs.gs,4),color);
  2400. SetColor(rs.ss,OldReg.ss);
  2401. WriteStr(14,5,'SS '+HexStr(rs.ss,4),color);
  2402. SetColor(rs.eflags and $1,OldReg.eflags and $1);
  2403. WriteStr(22,0,'c='+chr(byte((rs.eflags and $1)<>0)+48),color);
  2404. SetColor(rs.eflags and $20,OldReg.eflags and $20);
  2405. WriteStr(22,1,'z='+chr(byte((rs.eflags and $20)<>0)+48),color);
  2406. SetColor(rs.eflags and $80,OldReg.eflags and $80);
  2407. WriteStr(22,2,'s='+chr(byte((rs.eflags and $80)<>0)+48),color);
  2408. SetColor(rs.eflags and $800,OldReg.eflags and $800);
  2409. WriteStr(22,3,'o='+chr(byte((rs.eflags and $800)<>0)+48),color);
  2410. SetColor(rs.eflags and $4,OldReg.eflags and $4);
  2411. WriteStr(22,4,'p='+chr(byte((rs.eflags and $4)<>0)+48),color);
  2412. SetColor(rs.eflags and $200,OldReg.eflags and $200);
  2413. WriteStr(22,5,'i='+chr(byte((rs.eflags and $200)<>0)+48),color);
  2414. SetColor(rs.eflags and $10,OldReg.eflags and $10);
  2415. WriteStr(22,6,'a='+chr(byte((rs.eflags and $10)<>0)+48),color);
  2416. SetColor(rs.eflags and $400,OldReg.eflags and $400);
  2417. WriteStr(22,7,'d='+chr(byte((rs.eflags and $400)<>0)+48),color);
  2418. OldReg:=rs;
  2419. }
  2420. end
  2421. else
  2422. WriteStr(0,0,'<debugger error>',7);
  2423. end;
  2424. destructor TFPUView.Done;
  2425. begin
  2426. inherited done;
  2427. end;
  2428. {****************************************************************************
  2429. TFPUWindow
  2430. ****************************************************************************}
  2431. constructor TFPUWindow.Init;
  2432. var
  2433. R : TRect;
  2434. begin
  2435. Desktop^.GetExtent(R);
  2436. R.A.X:=R.B.X-28;
  2437. R.B.Y:=R.A.Y+11;
  2438. inherited Init(R,'FPU View', wnNoNumber);
  2439. Flags:=wfClose or wfMove;
  2440. Palette:=wpCyanWindow;
  2441. HelpCtx:=hcRegisters;
  2442. R.Assign(1,1,26,10);
  2443. RV:=new(PFPUView,init(R));
  2444. Insert(RV);
  2445. If assigned(FPUWindow) then
  2446. dispose(FPUWindow,done);
  2447. FPUWindow:=@Self;
  2448. Update;
  2449. end;
  2450. constructor TFPUWindow.Load(var S: TStream);
  2451. begin
  2452. inherited load(S);
  2453. GetSubViewPtr(S,RV);
  2454. If assigned(FPUWindow) then
  2455. dispose(FPUWindow,done);
  2456. FPUWindow:=@Self;
  2457. end;
  2458. procedure TFPUWindow.Store(var S: TStream);
  2459. begin
  2460. inherited Store(s);
  2461. PutSubViewPtr(S,RV);
  2462. end;
  2463. procedure TFPUWindow.Update;
  2464. begin
  2465. ReDraw;
  2466. end;
  2467. destructor TFPUWindow.Done;
  2468. begin
  2469. FPUWindow:=nil;
  2470. inherited done;
  2471. end;
  2472. {****************************************************************************
  2473. TStackWindow
  2474. ****************************************************************************}
  2475. constructor TFramesListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  2476. begin
  2477. Inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2478. end;
  2479. procedure TFramesListBox.Update;
  2480. var i : longint;
  2481. W : PSourceWindow;
  2482. begin
  2483. { call backtrace command }
  2484. If not assigned(Debugger) then
  2485. exit;
  2486. {$ifndef NODEBUG}
  2487. Clear;
  2488. { forget all old frames }
  2489. Debugger^.clear_frames;
  2490. Debugger^.Command('backtrace');
  2491. { generate list }
  2492. { all is in tframeentry }
  2493. for i:=Debugger^.frame_count-1 downto 0 do
  2494. begin
  2495. with Debugger^.frames[i]^ do
  2496. begin
  2497. AddItem(new(PMessageItem,init(0,GetPChar(function_name)+GetPChar(args),
  2498. AddModuleName(GetPChar(file_name)),line_number,1)));
  2499. W:=SearchOnDesktop(GetPChar(file_name),false);
  2500. If assigned(W) then
  2501. begin
  2502. W^.editor^.SetDebuggerRow(line_number);
  2503. end;
  2504. end;
  2505. end;
  2506. if List^.Count > 0 then
  2507. FocusItem(0);
  2508. {$endif}
  2509. end;
  2510. function TFramesListBox.GetLocalMenu: PMenu;
  2511. begin
  2512. GetLocalMenu:=Inherited GetLocalMenu;
  2513. end;
  2514. procedure TFramesListBox.GotoSource;
  2515. begin
  2516. { select frame for watches }
  2517. If not assigned(Debugger) then
  2518. exit;
  2519. {$ifdef NODEBUG}
  2520. Debugger^.Command('f '+IntToStr(Focused));
  2521. { for local vars }
  2522. Debugger^.ReadWatches;
  2523. {$endif}
  2524. { goto source }
  2525. inherited GotoSource;
  2526. end;
  2527. procedure TFramesListBox.HandleEvent(var Event: TEvent);
  2528. begin
  2529. inherited HandleEvent(Event);
  2530. end;
  2531. destructor TFramesListBox.Done;
  2532. begin
  2533. Inherited Done;
  2534. end;
  2535. Constructor TStackWindow.Init;
  2536. var
  2537. HSB,VSB: PScrollBar;
  2538. R,R2 : trect;
  2539. begin
  2540. Desktop^.GetExtent(R);
  2541. R.A.Y:=R.B.Y-5;
  2542. inherited Init(R, 'Call Stack', wnNoNumber);
  2543. Palette:=wpCyanWindow;
  2544. GetExtent(R);
  2545. HelpCtx:=hcStack;
  2546. R.Grow(-1,-1);
  2547. R2.Copy(R);
  2548. Inc(R2.B.Y);
  2549. R2.A.Y:=R2.B.Y-1;
  2550. New(HSB, Init(R2));
  2551. HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX;
  2552. Insert(HSB);
  2553. R2.Copy(R);
  2554. Inc(R2.B.X);
  2555. R2.A.X:=R2.B.X-1;
  2556. New(VSB, Init(R2));
  2557. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  2558. Insert(VSB);
  2559. New(FLB,Init(R,HSB,VSB));
  2560. FLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2561. Insert(FLB);
  2562. If assigned(StackWindow) then
  2563. dispose(StackWindow,done);
  2564. StackWindow:=@Self;
  2565. Update;
  2566. end;
  2567. procedure TStackWindow.Update;
  2568. begin
  2569. FLB^.Update;
  2570. DrawView;
  2571. end;
  2572. constructor TStackWindow.Load(var S: TStream);
  2573. begin
  2574. inherited Load(S);
  2575. GetSubViewPtr(S,FLB);
  2576. If assigned(StackWindow) then
  2577. dispose(StackWindow,done);
  2578. StackWindow:=@Self;
  2579. end;
  2580. procedure TStackWindow.Store(var S: TStream);
  2581. begin
  2582. inherited Store(S);
  2583. PutSubViewPtr(S,FLB);
  2584. end;
  2585. Destructor TStackWindow.Done;
  2586. begin
  2587. StackWindow:=nil;
  2588. Dispose(FLB,done);
  2589. inherited done;
  2590. end;
  2591. {****************************************************************************
  2592. Init/Final
  2593. ****************************************************************************}
  2594. procedure InitDebugger;
  2595. {$ifdef DEBUG}
  2596. var s : string;
  2597. i,p : longint;
  2598. {$endif DEBUG}
  2599. begin
  2600. {$ifdef DEBUG}
  2601. Assign(gdb_file,GDBOutFileName);
  2602. {$I-}
  2603. Rewrite(gdb_file);
  2604. if InOutRes<>0 then
  2605. begin
  2606. s:=GDBOutFileName;
  2607. p:=pos('.',s);
  2608. if p>1 then
  2609. for i:=0 to 9 do
  2610. begin
  2611. s:=copy(s,1,p-2)+chr(i+ord('0'))+copy(s,p,length(s));
  2612. InOutRes:=0;
  2613. Assign(gdb_file,s);
  2614. rewrite(gdb_file);
  2615. if InOutRes=0 then
  2616. break;
  2617. end;
  2618. end;
  2619. if IOResult=0 then
  2620. Use_gdb_file:=true;
  2621. {$I+}
  2622. {$endif}
  2623. if (not ExistsFile(ExeFile)) or (CompilationPhase<>cpDone) then
  2624. DoCompile(cRun);
  2625. if CompilationPhase<>cpDone then
  2626. Exit;
  2627. if (EXEFile='') then
  2628. begin
  2629. ErrorBox('Oooops, nothing to debug.',nil);
  2630. Exit;
  2631. end;
  2632. if target_os.shortname<>source_os.shortname then
  2633. begin
  2634. ErrorBox(#3'Sorry, I can only debug'#13#3'programs compiled for '#13#3
  2635. +source_os.shortname,nil);
  2636. Exit;
  2637. end;
  2638. { init debugcontroller }
  2639. if assigned(Debugger) then
  2640. dispose(Debugger,Done);
  2641. new(Debugger,Init(ExeFile));
  2642. {$ifdef GDBWINDOW}
  2643. InitGDBWindow;
  2644. {$endif def GDBWINDOW}
  2645. end;
  2646. procedure DoneDebugger;
  2647. begin
  2648. if assigned(Debugger) then
  2649. dispose(Debugger,Done);
  2650. Debugger:=nil;
  2651. {$ifdef DEBUG}
  2652. If Use_gdb_file then
  2653. Close(GDB_file);
  2654. Use_gdb_file:=false;
  2655. {$endif}
  2656. {DoneGDBWindow;}
  2657. end;
  2658. procedure InitGDBWindow;
  2659. var
  2660. R : TRect;
  2661. begin
  2662. if GDBWindow=nil then
  2663. begin
  2664. DeskTop^.GetExtent(R);
  2665. new(GDBWindow,init(R));
  2666. DeskTop^.Insert(GDBWindow);
  2667. end;
  2668. end;
  2669. procedure DoneGDBWindow;
  2670. begin
  2671. if assigned(GDBWindow) then
  2672. begin
  2673. DeskTop^.Delete(GDBWindow);
  2674. GDBWindow:=nil;
  2675. end;
  2676. end;
  2677. procedure InitStackWindow;
  2678. begin
  2679. if StackWindow=nil then
  2680. begin
  2681. new(StackWindow,init);
  2682. DeskTop^.Insert(StackWindow);
  2683. end;
  2684. end;
  2685. procedure DoneStackWindow;
  2686. begin
  2687. if assigned(StackWindow) then
  2688. begin
  2689. DeskTop^.Delete(StackWindow);
  2690. StackWindow:=nil;
  2691. end;
  2692. end;
  2693. procedure InitRegistersWindow;
  2694. begin
  2695. if RegistersWindow=nil then
  2696. begin
  2697. new(RegistersWindow,init);
  2698. DeskTop^.Insert(RegistersWindow);
  2699. end;
  2700. end;
  2701. procedure DoneRegistersWindow;
  2702. begin
  2703. if assigned(RegistersWindow) then
  2704. begin
  2705. DeskTop^.Delete(RegistersWindow);
  2706. RegistersWindow:=nil;
  2707. end;
  2708. end;
  2709. procedure InitBreakpoints;
  2710. begin
  2711. New(BreakpointsCollection,init(10,10));
  2712. end;
  2713. procedure DoneBreakpoints;
  2714. begin
  2715. Dispose(BreakpointsCollection,Done);
  2716. BreakpointsCollection:=nil;
  2717. end;
  2718. procedure InitWatches;
  2719. begin
  2720. New(WatchesCollection,init);
  2721. end;
  2722. procedure DoneWatches;
  2723. begin
  2724. Dispose(WatchesCollection,Done);
  2725. WatchesCollection:=nil;
  2726. end;
  2727. procedure RegisterFPDebugViews;
  2728. begin
  2729. RegisterType(RWatchesWindow);
  2730. RegisterType(RBreakpointsWindow);
  2731. RegisterType(RWatchesListBox);
  2732. RegisterType(RBreakpointsListBox);
  2733. RegisterType(RStackWindow);
  2734. RegisterType(RFramesListBox);
  2735. RegisterType(RBreakpoint);
  2736. RegisterType(RWatch);
  2737. RegisterType(RBreakpointCollection);
  2738. RegisterType(RWatchesCollection);
  2739. RegisterType(RRegistersWindow);
  2740. RegisterType(RRegistersView);
  2741. RegisterType(RFPUWindow);
  2742. RegisterType(RFPUView);
  2743. end;
  2744. end.
  2745. {
  2746. $Log$
  2747. Revision 1.46 2000-02-01 10:59:58 pierre
  2748. * allow FP to debug itself
  2749. Revision 1.45 2000/01/28 22:38:21 pierre
  2750. * CrtlF9 starts debugger if there are active breakpoints
  2751. Revision 1.44 2000/01/27 22:30:38 florian
  2752. * start of FPU window
  2753. * current executed line color has a higher priority then a breakpoint now
  2754. Revision 1.43 2000/01/20 00:31:53 pierre
  2755. * uses ShortName of exe to start GDB
  2756. Revision 1.42 2000/01/10 17:49:40 pierre
  2757. * Get RegisterView to Update correctly
  2758. * Write in white changed regs (keeping a copy of previous values)
  2759. Revision 1.41 2000/01/10 16:20:50 florian
  2760. * working register window
  2761. Revision 1.40 2000/01/10 13:20:57 pierre
  2762. + debug only possible on source target
  2763. Revision 1.39 2000/01/10 00:25:06 pierre
  2764. * RegisterWindow problem fixed
  2765. Revision 1.38 2000/01/09 21:05:51 florian
  2766. * some fixes for register view
  2767. Revision 1.37 2000/01/08 18:26:20 florian
  2768. + added a register window, doesn't work yet
  2769. Revision 1.36 1999/12/20 14:23:16 pierre
  2770. * MyApp renamed IDEApp
  2771. * TDebugController.ResetDebuggerRows added to
  2772. get resetting of debugger rows
  2773. Revision 1.35 1999/11/24 14:03:16 pierre
  2774. + Executing... in status line if in another window
  2775. Revision 1.34 1999/11/10 17:19:58 pierre
  2776. + Other window for Debuggee code
  2777. Revision 1.33 1999/10/25 16:39:03 pierre
  2778. + GetPChar to avoid nil pointer problems
  2779. Revision 1.32 1999/09/16 14:34:57 pierre
  2780. + TBreakpoint and TWatch registering
  2781. + WatchesCollection and BreakpointsCollection stored in desk file
  2782. * Syntax highlighting was broken
  2783. Revision 1.31 1999/09/13 16:24:43 peter
  2784. + clock
  2785. * backspace unident like tp7
  2786. Revision 1.30 1999/09/09 16:36:30 pierre
  2787. * Breakpoint storage problem corrected
  2788. Revision 1.29 1999/09/09 16:31:45 pierre
  2789. * some breakpoint related fixes and Help contexts
  2790. Revision 1.28 1999/09/09 14:20:05 pierre
  2791. + Stack Window
  2792. Revision 1.27 1999/08/24 22:04:33 pierre
  2793. + TCodeEditor.SetDebuggerRow
  2794. works like SetHighlightRow but is only disposed by a SetDebuggerRow(-1)
  2795. so the current stop point in debugging is not lost if
  2796. we move the cursor
  2797. Revision 1.26 1999/08/22 22:26:48 pierre
  2798. + Registration of Breakpoint/Watches windows
  2799. Revision 1.25 1999/08/16 18:25:15 peter
  2800. * Adjusting the selection when the editor didn't contain any line.
  2801. * Reserved word recognition redesigned, but this didn't affect the overall
  2802. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  2803. The syntax scanner loop is a bit slow but the main problem is the
  2804. recognition of special symbols. Switching off symbol processing boosts
  2805. the performance up to ca. 200%...
  2806. * The editor didn't allow copying (for ex to clipboard) of a single character
  2807. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  2808. * Compiler Messages window (actually the whole desktop) did not act on any
  2809. keypress when compilation failed and thus the window remained visible
  2810. + Message windows are now closed upon pressing Esc
  2811. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  2812. only when neccessary
  2813. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  2814. + LineSelect (Ctrl+K+L) implemented
  2815. * The IDE had problems closing help windows before saving the desktop
  2816. Revision 1.24 1999/08/03 20:22:28 peter
  2817. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  2818. + Desktop saving should work now
  2819. - History saved
  2820. - Clipboard content saved
  2821. - Desktop saved
  2822. - Symbol info saved
  2823. * syntax-highlight bug fixed, which compared special keywords case sensitive
  2824. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  2825. * with 'whole words only' set, the editor didn't found occourences of the
  2826. searched text, if the text appeared previously in the same line, but didn't
  2827. satisfied the 'whole-word' condition
  2828. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  2829. (ie. the beginning of the selection)
  2830. * when started typing in a new line, but not at the start (X=0) of it,
  2831. the editor inserted the text one character more to left as it should...
  2832. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  2833. * Shift shouldn't cause so much trouble in TCodeEditor now...
  2834. * Syntax highlight had problems recognizing a special symbol if it was
  2835. prefixed by another symbol character in the source text
  2836. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  2837. Revision 1.23 1999/07/28 23:11:17 peter
  2838. * fixes from gabor
  2839. Revision 1.22 1999/07/12 13:14:15 pierre
  2840. * LineEnd bug corrected, now goes end of text even if selected
  2841. + Until Return for debugger
  2842. + Code for Quit inside GDB Window
  2843. Revision 1.21 1999/07/11 00:35:14 pierre
  2844. * fix problems for wrong watches
  2845. Revision 1.20 1999/07/10 01:24:14 pierre
  2846. + First implementation of watches window
  2847. Revision 1.19 1999/06/30 23:58:12 pierre
  2848. + BreakpointsList Window implemented
  2849. with Edit/New/Delete functions
  2850. + Individual breakpoint dialog with support for all types
  2851. ignorecount and conditions
  2852. (commands are not yet implemented, don't know if this wolud be useful)
  2853. awatch and rwatch have problems because GDB does not annotate them
  2854. I fixed v4.16 for this
  2855. Revision 1.18 1999/03/16 00:44:42 peter
  2856. * forgotten in last commit :(
  2857. Revision 1.17 1999/03/02 13:48:28 peter
  2858. * fixed far problem is fpdebug
  2859. * tile/cascading with message window
  2860. * grep fixes
  2861. Revision 1.16 1999/03/01 15:41:52 peter
  2862. + Added dummy entries for functions not yet implemented
  2863. * MenuBar didn't update itself automatically on command-set changes
  2864. * Fixed Debugging/Profiling options dialog
  2865. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  2866. set
  2867. * efBackSpaceUnindents works correctly
  2868. + 'Messages' window implemented
  2869. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  2870. + Added TP message-filter support (for ex. you can call GREP thru
  2871. GREP2MSG and view the result in the messages window - just like in TP)
  2872. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  2873. so topic search didn't work...
  2874. * In FPHELP.PAS there were still context-variables defined as word instead
  2875. of THelpCtx
  2876. * StdStatusKeys() was missing from the statusdef for help windows
  2877. + Topic-title for index-table can be specified when adding a HTML-files
  2878. Revision 1.15 1999/02/20 15:18:29 peter
  2879. + ctrl-c capture with confirm dialog
  2880. + ascii table in the tools menu
  2881. + heapviewer
  2882. * empty file fixed
  2883. * fixed callback routines in fpdebug to have far for tp7
  2884. Revision 1.14 1999/02/16 12:47:36 pierre
  2885. * GDBWindow does not popup on F7 or F8 anymore
  2886. Revision 1.13 1999/02/16 10:43:54 peter
  2887. * use -dGDB for the compiler
  2888. * only use gdb_file when -dDEBUG is used
  2889. * profiler switch is now a toggle instead of radiobutton
  2890. Revision 1.12 1999/02/11 19:07:20 pierre
  2891. * GDBWindow redesigned :
  2892. normal editor apart from
  2893. that any kbEnter will send the line (for begin to cursor)
  2894. to GDB command !
  2895. GDBWindow opened in Debugger Menu
  2896. still buggy :
  2897. -echo should not be present if at end of text
  2898. -GDBWindow becomes First after each step (I don't know why !)
  2899. Revision 1.11 1999/02/11 13:10:03 pierre
  2900. + GDBWindow only with -dGDBWindow for now : still buggy !!
  2901. Revision 1.10 1999/02/10 09:55:07 pierre
  2902. + added OldValue and CurrentValue field for watchpoints
  2903. + InitBreakpoints and DoneBreakpoints
  2904. + MessageBox if GDB stops bacause of a watchpoint !
  2905. Revision 1.9 1999/02/08 17:43:43 pierre
  2906. * RestDebugger or multiple running of debugged program now works
  2907. + added DoContToCursor(F4)
  2908. * Breakpoints are now inserted correctly (was mainlyy a problem
  2909. of directories)
  2910. Revision 1.8 1999/02/05 17:21:52 pierre
  2911. Invalid_line renamed InvalidSourceLine
  2912. Revision 1.7 1999/02/05 13:08:41 pierre
  2913. + new breakpoint types added
  2914. Revision 1.6 1999/02/05 12:11:53 pierre
  2915. + SourceDir that stores directories for sources that the
  2916. compiler should not know about
  2917. Automatically asked for addition when a new file that
  2918. needed filedialog to be found is in an unknown directory
  2919. Stored and retrieved from INIFile
  2920. + Breakpoints conditions added to INIFile
  2921. * Breakpoints insterted and removed at debin and end of debug session
  2922. Revision 1.5 1999/02/04 17:54:22 pierre
  2923. + several commands added
  2924. Revision 1.4 1999/02/04 13:32:02 pierre
  2925. * Several things added (I cannot commit them independently !)
  2926. + added TBreakpoint and TBreakpointCollection
  2927. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  2928. + Breakpoint list in INIFile
  2929. * Select items now also depend of SwitchMode
  2930. * Reading of option '-g' was not possible !
  2931. + added search for -Fu args pathes in TryToOpen
  2932. + added code for automatic opening of FileDialog
  2933. if source not found
  2934. Revision 1.3 1999/02/02 16:41:38 peter
  2935. + automatic .pas/.pp adding by opening of file
  2936. * better debuggerscreen changes
  2937. Revision 1.2 1999/01/22 18:14:09 pierre
  2938. * adaptd to changes in gdbint and gdbcon for to /
  2939. Revision 1.1 1999/01/22 10:24:03 peter
  2940. * first debugger things
  2941. }