fpdebug.pas 74 KB

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