fpdebug.pas 66 KB

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