fpdebug.pas 74 KB

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