/ide/abstractsmethodsdlg.pas

http://github.com/graemeg/lazarus · Pascal · 399 lines · 313 code · 44 blank · 42 comment · 37 complexity · 24fa8934a8ce13af48a02ce33b06e05a 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. Author: Mattias Gaertner
  21. Abstract:
  22. A dialog showing the abstract methods of the current class
  23. (at cursor in source editor).
  24. With the ability to implement them automatically by adding empty method
  25. stubs.
  26. }
  27. unit AbstractsMethodsDlg;
  28. {$mode objfpc}{$H+}
  29. interface
  30. uses
  31. Classes, SysUtils, LCLProc, Forms, Controls, Graphics, Dialogs,
  32. CheckLst, StdCtrls, ExtCtrls, Buttons,
  33. CodeTree, PascalParserTool, CodeCache, CodeToolManager,
  34. LazIDEIntf, SrcEditorIntf, IDEDialogs,
  35. LazarusIDEStrConsts;
  36. type
  37. { TAbstractMethodDlgItem }
  38. TAbstractMethodDlgItem = class
  39. public
  40. CodeXYPos: TCodeXYPosition;
  41. ProcHead: string;
  42. BelongsToStartClass: boolean;
  43. end;
  44. { TAbstractMethodsDialog }
  45. TAbstractMethodsDialog = class(TForm)
  46. AddAllBitBtn: TBitBtn;
  47. NoteLabel: TLabel;
  48. SelectNoneButton: TButton;
  49. SelectAllButton: TButton;
  50. CancelBitBtn: TBitBtn;
  51. AddFirstBitBtn: TBitBtn;
  52. MethodsCheckListBox: TCheckListBox;
  53. MethodsGroupBox: TGroupBox;
  54. BtnPanel: TPanel;
  55. procedure AddAllBitBtnClick(Sender: TObject);
  56. procedure AddFirstBitBtnClick(Sender: TObject);
  57. procedure FormCreate(Sender: TObject);
  58. procedure FormDestroy(Sender: TObject);
  59. procedure MethodsCheckListBoxClickCheck(Sender: TObject);
  60. procedure SelectAllButtonClick(Sender: TObject);
  61. procedure SelectNoneButtonClick(Sender: TObject);
  62. private
  63. CodePos: TCodeXYPosition;
  64. TopLine: integer;
  65. FItems: TFPList;// list of TAbstractMethodDlgItem
  66. FCheckingSelection: boolean;
  67. procedure ClearItems;
  68. procedure UpdateButtons;
  69. function CheckSelection: boolean;
  70. function AddOverrides(OnlyFirst: boolean): boolean;
  71. public
  72. NewCode: TCodeBuffer;
  73. NewX,NewY,NewTopLine: integer;
  74. procedure Init(aListOfPCodeXYPosition: TFPList; aCode: TCodeBuffer;
  75. const aCaret: TPoint; aTopLine: integer);
  76. end;
  77. function ShowAbstractMethodsDialog: TModalResult;
  78. implementation
  79. {$R *.lfm}
  80. function ShowAbstractMethodsDialog: TModalResult;
  81. var
  82. AbstractMethodsDialog: TAbstractMethodsDialog;
  83. SrcEdit: TSourceEditorInterface;
  84. Code: TCodeBuffer;
  85. Caret: TPoint;
  86. ErrMsg: String;
  87. ListOfPCodeXYPosition: TFPList;
  88. begin
  89. Result:=mrCancel;
  90. ListOfPCodeXYPosition:=nil;
  91. try
  92. // init codetools
  93. ErrMsg:=lisSAMIDEIsBusy;
  94. if not LazarusIDE.BeginCodeTools then exit;
  95. // get cursor position
  96. ErrMsg:=lisSAMCursorIsNotInAClassDeclaration;
  97. SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
  98. if SrcEdit=nil then exit;
  99. Code:=TCodeBuffer(SrcEdit.CodeToolsBuffer);
  100. if Code=nil then exit;
  101. Caret:=SrcEdit.CursorTextXY;
  102. // check cursor is in a class
  103. if not CodeToolBoss.FindAbstractMethods(Code,Caret.X,Caret.Y,
  104. ListOfPCodeXYPosition,true) then
  105. begin
  106. DebugLn(['ShowAbstractMethodsDialog CodeToolBoss.FindAbstractMethods failed']);
  107. if CodeToolBoss.ErrorMessage<>'' then begin
  108. ErrMsg:='';
  109. LazarusIDE.DoJumpToCodeToolBossError;
  110. end;
  111. exit;
  112. end;
  113. // check if there are abstract methods left to override
  114. if (ListOfPCodeXYPosition=nil) or (ListOfPCodeXYPosition.Count=0) then begin
  115. ErrMsg:='';
  116. IDEMessageDialog(lisSAMNoAbstractMethodsFound,
  117. lisSAMThereAreNoAbstractMethodsLeftToOverride
  118. ,mtConfirmation,[mbOk]);
  119. Result:=mrOk;
  120. exit;
  121. end;
  122. ErrMsg:='';
  123. AbstractMethodsDialog:=TAbstractMethodsDialog.Create(nil);
  124. AbstractMethodsDialog.Init(ListOfPCodeXYPosition,Code,Caret,SrcEdit.TopLine);
  125. Result:=AbstractMethodsDialog.ShowModal;
  126. AbstractMethodsDialog.Free;
  127. finally
  128. CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
  129. if ErrMsg<>'' then begin
  130. IDEMessageDialog(lisCCOErrorCaption,
  131. lisSAMUnableToShowAbstractMethodsOfTheCurrentClassBecaus+LineEnding
  132. +ErrMsg,mtError,[mbCancel]);
  133. end;
  134. end;
  135. end;
  136. { TAbstractMethodsDialog }
  137. procedure TAbstractMethodsDialog.FormCreate(Sender: TObject);
  138. begin
  139. FItems:=TFPList.Create;
  140. AddFirstBitBtn.Caption:=lisSAMOverrideFirstSelected;
  141. AddAllBitBtn.Caption:=lisSAMOverrideAllSelected;
  142. CancelBitBtn.Caption:=lisCancel;
  143. SelectNoneButton.Caption:=lisSAMSelectNone;
  144. SelectAllButton.Caption:=lisMenuSelectAll;
  145. MethodsGroupBox.Caption:=lisSAMAbstractMethodsNotYetOverridden;
  146. end;
  147. procedure TAbstractMethodsDialog.AddFirstBitBtnClick(Sender: TObject);
  148. begin
  149. if not AddOverrides(true) then exit;
  150. ModalResult:=mrOk;
  151. end;
  152. procedure TAbstractMethodsDialog.AddAllBitBtnClick(Sender: TObject);
  153. begin
  154. if not AddOverrides(false) then exit;
  155. ModalResult:=mrOk;
  156. end;
  157. procedure TAbstractMethodsDialog.FormDestroy(Sender: TObject);
  158. begin
  159. ClearItems;
  160. end;
  161. procedure TAbstractMethodsDialog.MethodsCheckListBoxClickCheck(Sender: TObject);
  162. begin
  163. CheckSelection;
  164. UpdateButtons;
  165. end;
  166. procedure TAbstractMethodsDialog.SelectAllButtonClick(Sender: TObject);
  167. var
  168. i: Integer;
  169. begin
  170. for i:=0 to FItems.Count-1 do
  171. MethodsCheckListBox.Checked[i]:=
  172. not TAbstractMethodDlgItem(FItems[i]).BelongsToStartClass;
  173. end;
  174. procedure TAbstractMethodsDialog.SelectNoneButtonClick(Sender: TObject);
  175. var
  176. i: Integer;
  177. begin
  178. for i:=0 to FItems.Count-1 do
  179. MethodsCheckListBox.Checked[i]:=false;
  180. end;
  181. procedure TAbstractMethodsDialog.ClearItems;
  182. var
  183. i: Integer;
  184. begin
  185. if FItems=nil then exit;
  186. for i:=0 to FItems.Count-1 do
  187. TObject(FItems[i]).Free;
  188. FreeAndNil(FItems);
  189. end;
  190. procedure TAbstractMethodsDialog.UpdateButtons;
  191. var
  192. i: Integer;
  193. begin
  194. i:=MethodsCheckListBox.Items.Count-1;
  195. while (i>=0) and (not MethodsCheckListBox.Checked[i]) do dec(i);
  196. AddFirstBitBtn.Enabled:=i>=0;
  197. AddAllBitBtn.Enabled:=AddFirstBitBtn.Enabled;
  198. end;
  199. function TAbstractMethodsDialog.CheckSelection: boolean;
  200. var
  201. i: Integer;
  202. Item: TAbstractMethodDlgItem;
  203. begin
  204. Result:=true;
  205. if FCheckingSelection then exit;
  206. FCheckingSelection:=true;
  207. try
  208. for i:=0 to FItems.Count-1 do begin
  209. Item:=TAbstractMethodDlgItem(FItems[i]);
  210. if MethodsCheckListBox.Checked[i] and Item.BelongsToStartClass then begin
  211. if Result then begin
  212. IDEMessageDialog(lisCCOErrorCaption,
  213. lisSAMThisMethodCanNotBeOverriddenBecauseItIsDefinedInTh,
  214. mtError,[mbCancel]);
  215. Result:=false;
  216. end;
  217. MethodsCheckListBox.Checked[i]:=false;
  218. end;
  219. end;
  220. finally
  221. FCheckingSelection:=false;
  222. end;
  223. end;
  224. function TAbstractMethodsDialog.AddOverrides(OnlyFirst: boolean): boolean;
  225. var
  226. i: Integer;
  227. NewList: TFPList;
  228. Item: TAbstractMethodDlgItem;
  229. begin
  230. Result:=false;
  231. if not CheckSelection then exit;
  232. NewList:=nil;
  233. try
  234. for i:=0 to FItems.Count-1 do begin
  235. if not MethodsCheckListBox.Checked[i] then continue;
  236. Item:=TAbstractMethodDlgItem(FItems[i]);
  237. AddCodePosition(NewList,Item.CodeXYPos);
  238. DebugLn(['TAbstractMethodsDialog.AddOverrides ',Item.CodeXYPos.Code.Filename,' ',Item.CodeXYPos.X,',',Item.CodeXYPos.Y]);
  239. if OnlyFirst then break;
  240. end;
  241. //DebugLn(['TAbstractMethodsDialog.AddOverrides ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
  242. if not CodeToolBoss.AddMethods(CodePos.Code,CodePos.X,CodePos.Y,TopLine,
  243. NewList,true,NewCode,NewX,NewY,NewTopLine)
  244. then begin
  245. LazarusIDE.DoJumpToCodeToolBossError;
  246. exit;
  247. end;
  248. LazarusIDE.DoOpenFileAndJumpToPos(NewCode.Filename,Point(NewX,NewY),
  249. NewTopLine,-1,-1,[]);
  250. finally
  251. CodeToolBoss.FreeListOfPCodeXYPosition(NewList);
  252. end;
  253. Result:=true;
  254. end;
  255. procedure TAbstractMethodsDialog.Init(aListOfPCodeXYPosition: TFPList;
  256. aCode: TCodeBuffer; const aCaret: TPoint; aTopLine: integer);
  257. var
  258. i: Integer;
  259. CodeXYPos: TCodeXYPosition;
  260. CurTool: TCodeTool;
  261. ListOfPCodeXYPosition: TFPList;
  262. Tool: TCodeTool;
  263. CleanPos: integer;
  264. ClassNode: TCodeTreeNode;
  265. CurNode: TCodeTreeNode;
  266. ProcNode: TCodeTreeNode;
  267. NewItem: TAbstractMethodDlgItem;
  268. StartClassName: String;
  269. BelongsToStartClassCnt: Integer;
  270. NoteStr: String;
  271. begin
  272. ListOfPCodeXYPosition:=aListOfPCodeXYPosition;
  273. if ListOfPCodeXYPosition=nil then begin
  274. DebugLn(['TAbstractMethodsDialog.Init ListOfPCodeXYPosition=nil']);
  275. exit;
  276. end;
  277. CodePos.Code:=aCode;
  278. CodePos.X:=aCaret.X;
  279. CodePos.Y:=aCaret.Y;
  280. TopLine:=aTopLine;
  281. // get Tool and ClassNode
  282. Tool:=CodeToolBoss.GetCodeToolForSource(CodePos.Code,true,false) as TCodeTool;
  283. if Tool.CaretToCleanPos(CodePos,CleanPos)<>0 then begin
  284. DebugLn(['TAbstractMethodsDialog.Init invalid ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
  285. exit;
  286. end;
  287. ClassNode:=Tool.FindDeepestNodeAtPos(CleanPos,false);
  288. if ClassNode=nil then begin
  289. DebugLn(['TAbstractMethodsDialog.Init no node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
  290. exit;
  291. end;
  292. if ClassNode.Desc=ctnTypeDefinition then
  293. ClassNode:=ClassNode.FirstChild
  294. else if ClassNode.Desc=ctnGenericType then
  295. ClassNode:=ClassNode.LastChild
  296. else
  297. ClassNode:=Tool.FindClassOrInterfaceNode(ClassNode);
  298. if (ClassNode=nil) then begin
  299. DebugLn(['TAbstractMethodsDialog.Init no class node at cursor ',CodePos.Code.Filename,' ',CodePos.X,',',CodePos.Y]);
  300. exit;
  301. end;
  302. StartClassName:=Tool.ExtractClassName(ClassNode,false);
  303. BelongsToStartClassCnt:=0;
  304. // create items
  305. for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
  306. CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
  307. CurTool:=CodeToolBoss.GetCodeToolForSource(CodeXYPos.Code,true,false) as TCodeTool;
  308. if CurTool.CaretToCleanPos(CodeXYPos,CleanPos)<>0 then begin
  309. DebugLn(['TAbstractMethodsDialog.Init skipping ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
  310. continue;
  311. end;
  312. CurNode:=CurTool.FindDeepestNodeAtPos(CleanPos,false);
  313. if CurNode=nil then begin
  314. DebugLn(['TAbstractMethodsDialog.Init no node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
  315. continue;
  316. end;
  317. if CurNode.Desc<>ctnProcedure then begin
  318. DebugLn(['TAbstractMethodsDialog.Init no proc node at ',CodeXYPos.Code.Filename,' ',CodeXYPos.X,',',CodeXYPos.Y]);
  319. continue;
  320. end;
  321. ProcNode:=CurNode;
  322. NewItem:=TAbstractMethodDlgItem.Create;
  323. NewItem.CodeXYPos:=CodeXYPos;
  324. NewItem.ProcHead:=CurTool.ExtractProcHead(ProcNode,[phpAddClassname,
  325. phpWithStart,phpWithParameterNames,phpWithVarModifiers,
  326. phpWithDefaultValues,phpWithResultType,
  327. phpWithOfObject,phpWithCallingSpecs]);
  328. NewItem.BelongsToStartClass:=ProcNode.HasAsParent(ClassNode);
  329. if NewItem.BelongsToStartClass then
  330. inc(BelongsToStartClassCnt);
  331. FItems.Add(NewItem);
  332. end;
  333. MethodsCheckListBox.Clear;
  334. for i:=0 to FItems.Count-1 do begin
  335. NewItem:=TAbstractMethodDlgItem(FItems[i]);
  336. MethodsCheckListBox.Items.Add(NewItem.ProcHead);
  337. MethodsCheckListBox.Checked[i]:=not NewItem.BelongsToStartClass;
  338. end;
  339. // caption
  340. Caption:=Format(lisSAMAbstractMethodsOf, [StartClassName]);
  341. // note
  342. NoteStr:='';
  343. if BelongsToStartClassCnt>0 then begin
  344. NoteStr:=Format(lisSAMIsAnAbstractClassItHasAbstractMethods,
  345. [StartClassName, IntToStr(BelongsToStartClassCnt)])+LineEnding;
  346. end;
  347. NoteStr:=NoteStr+
  348. Format(lisSAMThereAreAbstractMethodsToOverrideSelectTheMethodsF,
  349. [IntToStr(FItems.Count-BelongsToStartClassCnt), LineEnding]);
  350. NoteLabel.Caption:=NoteStr;
  351. UpdateButtons;
  352. end;
  353. end.