fpdebug.pas 80 KB

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