/debugger/frames/debugger_language_exceptions_options.pas

http://github.com/graemeg/lazarus · Pascal · 205 lines · 156 code · 25 blank · 24 comment · 14 complexity · edbb091a287bd44a60b5ef7e0e28d62f MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. }
  21. unit debugger_language_exceptions_options;
  22. {$mode objfpc}{$H+}
  23. interface
  24. uses
  25. Classes, SysUtils, FileUtil, Forms, Controls, StdCtrls, CheckLst,
  26. Buttons, Dialogs,
  27. LazarusIDEStrConsts, IDEOptionsIntf, Debugger, BaseDebugManager;
  28. type
  29. { TDebuggerLanguageExceptionsOptions }
  30. TDebuggerLanguageExceptionsOptions = class(TAbstractIDEOptionsEditor)
  31. bgIgnoreExceptions: TGroupBox;
  32. chkNotifyOnException: TCheckBox;
  33. clbExceptions: TCheckListBox;
  34. cmdExceptionAdd: TBitBtn;
  35. cmdExceptionRemove: TBitBtn;
  36. DbgLangExceptHint: TLabel;
  37. procedure clbExceptionsClick(Sender: TObject);
  38. procedure cmdExceptionAddClick(Sender: TObject);
  39. procedure cmdExceptionRemoveClick(Sender: TObject);
  40. private
  41. FExceptionDeleteList: TStringList;
  42. procedure AddExceptionLine(const AException: TIDEException; AName: String);
  43. public
  44. constructor Create(AOwner: TComponent); override;
  45. destructor Destroy; override;
  46. function GetTitle: String; override;
  47. procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
  48. procedure ReadSettings({%H-}AOptions: TAbstractIDEOptions); override;
  49. procedure WriteSettings({%H-}AOptions: TAbstractIDEOptions); override;
  50. class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
  51. end;
  52. implementation
  53. {$R *.lfm}
  54. { TDebuggerLanguageExceptionsOptions }
  55. procedure TDebuggerLanguageExceptionsOptions.cmdExceptionAddClick(
  56. Sender: TObject);
  57. var
  58. idx: Integer;
  59. S: String;
  60. begin
  61. S:='';
  62. if not InputQuery(lisDebugOptionsFrmAddException, lisDebugOptionsFrmEnterExceptionName, S)
  63. then Exit;
  64. if clbExceptions.Items.IndexOf(S) = -1
  65. then begin
  66. idx := FExceptionDeleteList.IndexOf(S);
  67. if idx = -1
  68. then begin
  69. AddExceptionLine(nil, S);
  70. end
  71. else begin
  72. AddExceptionLine(TIDEException(FExceptionDeleteList.Objects[idx]), S);
  73. FExceptionDeleteList.Delete(idx);
  74. end;
  75. end
  76. else begin
  77. MessageDlg(lisDebugOptionsFrmDuplicateExceptionName, mtError, [mbOK], 0);
  78. end;
  79. end;
  80. procedure TDebuggerLanguageExceptionsOptions.clbExceptionsClick(Sender: TObject);
  81. begin
  82. cmdExceptionRemove.Enabled := clbExceptions.ItemIndex <> -1;
  83. end;
  84. procedure TDebuggerLanguageExceptionsOptions.cmdExceptionRemoveClick(
  85. Sender: TObject);
  86. var
  87. idx: Integer;
  88. obj: TObject;
  89. begin
  90. idx := clbExceptions.ItemIndex;
  91. if idx <> -1
  92. then begin
  93. obj := clbExceptions.Items.Objects[idx];
  94. if obj <> nil
  95. then FExceptionDeleteList.AddObject(clbExceptions.Items[idx], obj);
  96. clbExceptions.Items.Delete(idx);
  97. end;
  98. cmdExceptionRemove.Enabled := clbExceptions.ItemIndex <> -1;
  99. end;
  100. procedure TDebuggerLanguageExceptionsOptions.AddExceptionLine(
  101. const AException: TIDEException; AName: String);
  102. var
  103. idx: Integer;
  104. begin
  105. if (AName = '') and (AException <> nil)
  106. then AName := AException.Name;
  107. if AName = '' then Exit;
  108. idx := clbExceptions.Items.AddObject(AName, AException);
  109. clbExceptions.Checked[idx] := (AException = nil) or AException.Enabled;
  110. end;
  111. constructor TDebuggerLanguageExceptionsOptions.Create(AOwner: TComponent);
  112. begin
  113. inherited Create(AOwner);
  114. FExceptionDeleteList := TStringList.Create;
  115. FExceptionDeleteList.Sorted := True;
  116. end;
  117. destructor TDebuggerLanguageExceptionsOptions.Destroy;
  118. begin
  119. FreeAndNil(FExceptionDeleteList);
  120. inherited Destroy;
  121. end;
  122. function TDebuggerLanguageExceptionsOptions.GetTitle: String;
  123. begin
  124. Result := lisDebugOptionsFrmLanguageExceptions;
  125. end;
  126. procedure TDebuggerLanguageExceptionsOptions.Setup(
  127. ADialog: TAbstractOptionsEditorDialog);
  128. begin
  129. bgIgnoreExceptions.Caption := lisDebugOptionsFrmIgnoreTheseExceptions;
  130. DbgLangExceptHint.Caption := lisTheseSettingsAreStoredWithTheProject;
  131. cmdExceptionRemove.Caption := lisRemove;
  132. cmdExceptionAdd.Caption := lisAdd;
  133. cmdExceptionRemove.LoadGlyphFromResourceName(HInstance, 'laz_delete');
  134. cmdExceptionAdd.LoadGlyphFromResourceName(HInstance, 'laz_add');
  135. chkNotifyOnException.Caption := lisDebugOptionsFrmNotifyOnLazarusExceptions;
  136. end;
  137. procedure TDebuggerLanguageExceptionsOptions.ReadSettings(
  138. AOptions: TAbstractIDEOptions);
  139. var
  140. n: integer;
  141. begin
  142. chkNotifyOnException.Checked := not DebugBoss.Exceptions.IgnoreAll;
  143. for n := 0 to DebugBoss.Exceptions.Count - 1 do
  144. AddExceptionLine(DebugBoss.Exceptions[n], '');
  145. end;
  146. procedure TDebuggerLanguageExceptionsOptions.WriteSettings(
  147. AOptions: TAbstractIDEOptions);
  148. var
  149. n: integer;
  150. ie: TIDEException;
  151. begin
  152. for n := 0 to FExceptionDeleteList.Count - 1 do
  153. FExceptionDeleteList.Objects[n].Free;
  154. for n := 0 to clbExceptions.Items.Count - 1 do
  155. begin
  156. ie := TIDEException(clbExceptions.Items.Objects[n]);
  157. if ie = nil
  158. then begin
  159. ie := DebugBoss.Exceptions.Add(clbExceptions.Items[n]);
  160. ie.Enabled := clbExceptions.Checked[n];
  161. end
  162. else begin
  163. ie.BeginUpdate;
  164. try
  165. ie.Name := clbExceptions.Items[n];
  166. ie.Enabled := clbExceptions.Checked[n];
  167. finally
  168. ie.EndUpdate;
  169. end;
  170. end;
  171. end;
  172. DebugBoss.Exceptions.IgnoreAll := not chkNotifyOnException.Checked;
  173. end;
  174. class function TDebuggerLanguageExceptionsOptions.SupportedOptionsClass: TAbstractIDEOptionsClass;
  175. begin
  176. Result := TDebuggerOptions;
  177. end;
  178. initialization
  179. RegisterIDEOptionsEditor(GroupDebugger, TDebuggerLanguageExceptionsOptions, DbgOptionsLanguageExceptions);
  180. end.