FunctionList.pas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137
  1. unit FunctionList;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, StdCtrls, JvExStdCtrls, JvListBox, JvDotNetControls, ShellAPI,
  6. JvComponent, JvDockControlForm, ComCtrls, JvExComCtrls, JvListView,
  7. ImgList, ToolWin, Misc;
  8. type
  9. TfrmFunctionList = class(TForm)
  10. JvDockClient1: TJvDockClient;
  11. lvwFunctions: TJvDotNetListView;
  12. tblFunctionList: TToolBar;
  13. tbtnRefresh: TToolButton;
  14. imlFunctionList: TImageList;
  15. ToolButton1: TToolButton;
  16. tbtnGotoDef: TToolButton;
  17. procedure lvwFunctionsDblClick(Sender: TObject);
  18. procedure tbtnRefreshClick(Sender: TObject);
  19. procedure tbtnGotoDefClick(Sender: TObject);
  20. private
  21. { Private declarations }
  22. public
  23. { Public declarations }
  24. procedure RefreshList(sFileName: String);
  25. end;
  26. var
  27. frmFunctionList: TfrmFunctionList;
  28. implementation
  29. uses Main;
  30. {$R *.dfm}
  31. procedure TfrmFunctionList.RefreshList(sFileName: String);
  32. var
  33. CTagAppPath, TagFile, CTagParams: String;
  34. sTag: String;
  35. cmdLine: String;
  36. x: Integer;
  37. lstTags: TStringList;
  38. pFctInfo: TFctInfo;
  39. pItem: TListItem;
  40. si: TStartupInfo;
  41. pi: TProcessInformation;
  42. begin
  43. // Create temp directory if required
  44. if not DirectoryExists(TempFolder) then
  45. CreateDir(TempFolder);
  46. // Free previously created TFctInfo objects...
  47. for x := 0 to lvwFunctions.Items.Count - 1 do
  48. TFctInfo(lvwFunctions.Items[x].Data).Free;
  49. lstTags := TStringList.Create;
  50. lvwFunctions.Items.Clear;
  51. lvwFunctions.Items.BeginUpdate;
  52. // Build executable and its parameters strings
  53. CTagAppPath := '"' + GetLuaEditInstallPath() + '\ctags.exe"';
  54. TagFile := TempFolder + '\' + ExtractFileName(ChangeFileExt(sFileName, '.tag'));
  55. CTagParams := '"-f' + TagFile + '" "--fields=+n+S+K" "' + sFileName + '"';
  56. // Initialize createprocess variables for call
  57. FillChar(si, sizeof(si), 0);
  58. si.cb := sizeof(si);
  59. cmdLine := CTagAppPath + ' ' + CTagParams;
  60. // get the tags from the source
  61. CreateProcess(nil, PChar(cmdLine), nil, nil, True, CREATE_NO_WINDOW, nil, nil, si, pi);
  62. // Wait until the process is done
  63. WaitForSingleObject(pi.hProcess, INFINITE);
  64. // Closing handles
  65. CloseHandle(pi.hProcess);
  66. CloseHandle(pi.hThread);
  67. // Read the created tag file
  68. lstTags.LoadFromFile(TagFile);
  69. // searching for tags
  70. for x := 0 to lstTags.Count - 1 do
  71. begin
  72. sTag := lstTags.Strings[x];
  73. // make sure this line is not a comment
  74. if Pos('!_', sTag) <> 1 then
  75. begin
  76. pFctInfo := TFctInfo.Create;
  77. // Get the definition
  78. pFctInfo.FctDef := StringReplace(Copy(sTag, Pos('/^', sTag) + 2, Pos('$/;"', sTag) - Pos('/^', sTag) - 2), 'function ', '', [rfReplaceAll, rfIgnoreCase]);
  79. // Get the function's parameters
  80. pFctInfo.Params := Copy(pFctInfo.FctDef, Pos('(', pFctInfo.FctDef) + 1, Length(pFctInfo.FctDef) - 1 - Pos('(', pFctInfo.FctDef));
  81. // Get the line definition
  82. pFctInfo.Line := StrToInt(Copy(sTag, Pos('line:', sTag) + 5, Length(sTag) - Pos('line:', sTag) - 4));
  83. // Add function definition in list
  84. pItem := lvwFunctions.Items.Add;
  85. pItem.Caption := pFctInfo.FctDef;
  86. pItem.Data := pFctInfo;
  87. pItem.SubItems.Add(IntToStr(pFctInfo.Line));
  88. end;
  89. end;
  90. lvwFunctions.Items.EndUpdate;
  91. lstTags.Free;
  92. end;
  93. procedure TfrmFunctionList.lvwFunctionsDblClick(Sender: TObject);
  94. begin
  95. tbtnGotoDef.Click;
  96. end;
  97. procedure TfrmFunctionList.tbtnRefreshClick(Sender: TObject);
  98. begin
  99. if Assigned(frmLuaEditMain.jvUnitBar.SelectedTab) then
  100. begin
  101. if Assigned(frmLuaEditMain.jvUnitBar.SelectedTab.Data) then
  102. begin
  103. RefreshList(TLuaEditUnit(frmLuaEditMain.jvUnitBar.SelectedTab.Data).Path);
  104. end;
  105. end;
  106. end;
  107. procedure TfrmFunctionList.tbtnGotoDefClick(Sender: TObject);
  108. begin
  109. if Assigned(lvwFunctions.Selected) then
  110. frmLuaEditMain.PopUpUnitToScreen(TLuaEditUnit(frmLuaEditMain.jvUnitBar.SelectedTab.Data).Path, TFctInfo(lvwFunctions.Selected.Data).Line, False, HIGHLIGHT_STACK)
  111. end;
  112. end.