/components/jcf2/ReadWrite/EditorConverter.pas

http://github.com/graemeg/lazarus · Pascal · 503 lines · 320 code · 91 blank · 92 comment · 31 complexity · 72d4581fe42c4bdbaa1e71f65e4a9b29 MD5 · raw file

  1. unit EditorConverter;
  2. {(*}
  3. (*------------------------------------------------------------------------------
  4. Delphi Code formatter source code
  5. The Original Code is EditorConverter.pas, released January 2001.
  6. The Initial Developer of the Original Code is Anthony Steele.
  7. Portions created by Anthony Steele are Copyright (C) 2001 Anthony Steele.
  8. All Rights Reserved.
  9. Contributor(s): Anthony Steele.
  10. The contents of this file are subject to the Mozilla Public License Version 1.1
  11. (the "License"). you may not use this file except in compliance with the License.
  12. You may obtain a copy of the License at http://www.mozilla.org/NPL/
  13. Software distributed under the License is distributed on an "AS IS" basis,
  14. WITHOUT WARRANTY OF ANY KIND, either express or implied.
  15. See the License for the specific language governing rights and limitations
  16. under the License.
  17. Alternatively, the contents of this file may be used under the terms of
  18. the GNU General Public License Version 2 or later (the "GPL")
  19. See http://www.gnu.org/licenses/gpl.html
  20. ------------------------------------------------------------------------------*)
  21. {*)}
  22. { AFS 12 Jan 2K
  23. Converter class for the IDE pluggin
  24. }
  25. {$I JcfGlobal.inc}
  26. interface
  27. uses
  28. Classes,
  29. {$ifdef fpc}
  30. { lazarus design time }
  31. SrcEditorIntf, LazUTF8,
  32. {$else}
  33. { delphi design time }
  34. ToolsAPI,
  35. {$endif}
  36. { local }
  37. Converter, ConvertTypes;
  38. type
  39. TEditorConverter = class(TObject)
  40. private
  41. { the string -> string converter }
  42. fcConverter: TConverter;
  43. { state }
  44. fOnStatusMessage: TStatusMessageProc;
  45. fsCurrentUnitName: string;
  46. fiConvertCount: integer;
  47. procedure SendStatusMessage(const psUnit, psMessage: string;
  48. const peMessageType: TStatusMessageType;
  49. const piY, piX: integer);
  50. function GetOnStatusMessage: TStatusMessageProc;
  51. procedure SetOnStatusMessage(const Value: TStatusMessageProc);
  52. {$ifdef fpc}
  53. function ReadFromIDE(const pcUnit: TSourceEditorInterface): string;
  54. procedure WriteToIDE(const pcUnit: TSourceEditorInterface; const psText: string);
  55. {$else}
  56. function ReadFromIDE(const pcUnit: IOTASourceEditor): string;
  57. procedure WriteToIDE(const pcUnit: IOTASourceEditor; const psText: string);
  58. {$endif}
  59. procedure FinalSummary;
  60. function OriginalFileName: string;
  61. protected
  62. public
  63. constructor Create;
  64. destructor Destroy; override;
  65. {$ifdef fpc}
  66. procedure Convert(const pciUnit: TSourceEditorInterface);
  67. {$else}
  68. procedure Convert(const pciUnit: IOTASourceEditor);
  69. {$endif}
  70. procedure Clear;
  71. function ConvertError: Boolean;
  72. function TokenCount: integer;
  73. procedure BeforeConvert;
  74. procedure AfterConvert;
  75. property OnStatusMessage: TStatusMessageProc read GetOnStatusMessage write SetOnStatusMessage;
  76. end;
  77. implementation
  78. uses
  79. { delphi }
  80. SysUtils, Math,
  81. { local }
  82. JcfLog, JcfRegistrySettings, JcfMiscFunctions;
  83. constructor TEditorConverter.Create;
  84. begin
  85. inherited;
  86. fcConverter := TConverter.Create;
  87. fcConverter.OnStatusMessage := SendStatusMessage;
  88. end;
  89. destructor TEditorConverter.Destroy;
  90. begin
  91. FreeAndNil(fcConverter);
  92. inherited;
  93. end;
  94. {$ifdef fpc}
  95. procedure TEditorConverter.Convert(const pciUnit: TSourceEditorInterface);
  96. begin
  97. Assert(pciUnit <> nil);
  98. if not GetRegSettings.HasRead then
  99. GetRegSettings.ReadAll;
  100. { check for read-only }
  101. if pciUnit.ReadOnly then
  102. begin
  103. SendStatusMessage(pciUnit.FileName, 'Unit is read only. Cannot format ',
  104. mtInputError, -1, -1);
  105. exit;
  106. end;
  107. fsCurrentUnitName := pciUnit.FileName;
  108. fcConverter.InputCode := ReadFromIDE(pciUnit);
  109. // now convert
  110. fcConverter.Convert;
  111. fsCurrentUnitName := '';
  112. if not ConvertError then
  113. begin
  114. WriteToIDE(pciUnit, fcConverter.OutputCode);
  115. SendStatusMessage(pciUnit.FileName, 'Formatted unit', mtProgress, -1, -1);
  116. Inc(fiConvertCount);
  117. end;
  118. end;
  119. function TEditorConverter.ReadFromIDE(const pcUnit: TSourceEditorInterface): string;
  120. begin
  121. Result := pcUnit.Lines.Text;
  122. end;
  123. procedure TEditorConverter.WriteToIDE(const pcUnit: TSourceEditorInterface; const psText: string);
  124. var
  125. lcSourceLines, lcDestLines: TStrings;
  126. lcSameStart, lcSameEnd: TStrings;
  127. lsSourceLine, lsDestLine: string;
  128. liStart, liIndex, liMaxIndex: integer;
  129. hasSourceLine: Boolean;
  130. begin
  131. if pcUnit = nil then
  132. exit;
  133. lcSourceLines := TStringList.Create;
  134. lcSourceLines.Text := fcConverter.InputCode;
  135. lcDestLines := TStringList.Create;
  136. lcDestLines.Text := psText;
  137. lcSameStart := TStringList.Create;
  138. lcSameEnd := TStringList.Create;
  139. SplitIntoChangeSections(lcSourceLines, lcDestLines, lcSameStart, lcSameEnd);
  140. try
  141. pcUnit.BeginUpdate;
  142. pcUnit.BeginUndoBlock;
  143. liStart := lcSameStart.Count;
  144. liIndex := 0;
  145. liMaxIndex := Max(lcSourceLines.Count, lcDestLines.Count);
  146. while (liIndex < liMaxIndex) do
  147. begin
  148. hasSourceLine := liIndex < lcSourceLines.Count;
  149. if hasSourceLine then
  150. lsSourceLine := lcSourceLines[liIndex]
  151. else
  152. lsSourceLine := '';
  153. if liIndex < lcDestLines.Count then
  154. lsDestLine := lcDestLines[liIndex]
  155. else
  156. lsDestLine := '';
  157. if not hasSourceLine then
  158. pcUnit.InsertLine(liStart + liIndex + 1, lsDestLine, True)
  159. else
  160. if not AnsiSameStr(lsSourceLine, lsDestLine) then
  161. // the line is different, replace it
  162. pcUnit.ReplaceLines(liStart + liIndex + 1, liStart + liIndex + 1, lsDestLine, True);
  163. inc(liIndex);
  164. end;
  165. finally
  166. pcUnit.EndUndoBlock;
  167. pcUnit.EndUpdate;
  168. lcSourceLines.Free;
  169. lcDestLines.Free;
  170. lcSameStart.Free;
  171. lcSameEnd.Free;
  172. end;
  173. end;
  174. {$else}
  175. procedure TEditorConverter.Convert(const pciUnit: IOTASourceEditor);
  176. var
  177. lcBuffer: IOTAEditBuffer;
  178. begin
  179. Assert(pciUnit <> nil);
  180. if not GetRegSettings.HasRead then
  181. GetRegSettings.ReadAll;
  182. { check for read-only }
  183. pciUnit.QueryInterface(IOTAEditBuffer, lcBuffer);
  184. if pciUnit <> nil then
  185. begin
  186. lcBuffer := pciUnit as IOTAEditBuffer;
  187. if lcBuffer.IsReadOnly then
  188. begin
  189. SendStatusMessage(lcBuffer.FileName, 'Unit is read only. Cannot format ',
  190. mtInputError, -1, -1);
  191. exit;
  192. end;
  193. end;
  194. fsCurrentUnitName := lcBuffer.FileName;
  195. fcConverter.InputCode := ReadFromIDE(pciUnit);
  196. // now convert
  197. fcConverter.Convert;
  198. fsCurrentUnitName := '';
  199. if not ConvertError then
  200. begin
  201. WriteToIDE(pciUnit, fcConverter.OutputCode);
  202. SendStatusMessage(lcBuffer.FileName, 'Formatted unit', mtProgress, -1, -1);
  203. Inc(fiConvertCount);
  204. end;
  205. end;
  206. function TEditorConverter.ReadFromIDE(const pcUnit: IOTASourceEditor): string;
  207. const
  208. // 10 kb at a time should do it
  209. BUF_SIZE = 10240;
  210. //BUF_SIZE = 120; // small for testing
  211. var
  212. lciEditorReader: IOTAEditReader;
  213. lsBuf: AnsiString;
  214. lpBuf: PAnsiChar;
  215. liActualSize, liPos: integer;
  216. lbDone: boolean;
  217. //liLoopCount: integer;
  218. begin
  219. { get a reader from the unit }
  220. Assert(pcUnit <> nil);
  221. lciEditorReader := pcUnit.CreateReader;
  222. Assert(lciEditorReader <> nil);
  223. Result := '';
  224. // read it all. Unfortunately the API dictates that we will work in chunks
  225. liPos := 0;
  226. //liLoopCount := 0;
  227. lbDone := False;
  228. while not lbDone do
  229. begin
  230. // clear the buffer
  231. SetLength(lsBuf, BUF_SIZE);
  232. lpBuf := PAnsiChar(lsBuf);
  233. FillChar(lpBuf^, BUF_SIZE, 0);
  234. // get some text into the buffer
  235. liActualSize := lciEditorReader.GetText(liPos, lpBuf, BUF_SIZE);
  236. // store it
  237. {WP: Do not add the entire lsBuf to fsSource, as in cases where the entire source is less
  238. than 10Kb in total, there will be junk in the last part of the buffer.
  239. If this is copied, it shows up as extraneous tokens in the token list
  240. after the end of the unit proper.
  241. This then causes an assertion failure in procedure DoConvertUnit in unit Converter.pas,
  242. When these extra tokens are found that were not consumed by BuildParseTree
  243. The way is to ensure that you only append as many characters as you've actually read (liActualSize bytes)
  244. from the buffer into the result. }
  245. Result := Result + string(Copy(lsBuf, 1, liActualSize));
  246. //WP: Changed from just adding lsBuf
  247. // more stuff to read after this?
  248. liPos := liPos + liActualSize;
  249. lbDone := (liActualSize < BUF_SIZE);
  250. //inc(liLoopCount);
  251. end;
  252. end;
  253. { write the text back to the ide
  254. this is not as simple as you may think
  255. identical lines of text are skipped over not written
  256. ( not in all cases, but the simple cases are covered)
  257. so as to preserve the editor's notion of what has changed and what has not
  258. }
  259. procedure TEditorConverter.WriteToIDE(const pcUnit: IOTASourceEditor; const psText: string);
  260. var
  261. lciEditorWriter: IOTAEditWriter;
  262. lsOriginalSource: string;
  263. liSourcePos{, liDestPos}: integer;
  264. lcSourceLines, lcDestLines: TStrings;
  265. lcSameStart, lcSameEnd: TStrings;
  266. lsSourceLine, lsDestLine: string;
  267. liIndex, liMaxIndex: integer;
  268. begin
  269. if pcUnit = nil then
  270. exit;
  271. lciEditorWriter := pcUnit.CreateUndoableWriter;
  272. Assert(lciEditorWriter <> nil);
  273. liSourcePos := 0;
  274. lsOriginalSource := fcConverter.InputCode;
  275. lcSourceLines := SplitIntoLines(lsOriginalSource);
  276. lcDestLines := SplitIntoLines(psText);
  277. lcSameStart := TStringList.Create;
  278. lcSameEnd := TStringList.Create;
  279. SplitIntoChangeSections(lcSourceLines, lcDestLines, lcSameStart, lcSameEnd);
  280. try
  281. // clear off identical text at the start
  282. for liIndex := 0 to lcSameStart.Count - 1 do
  283. begin
  284. liSourcePos := liSourcePos + Length(lcSameStart[liIndex]);
  285. end;
  286. lciEditorWriter.CopyTo(liSourcePos);
  287. //liDestPos := liSourcePos;
  288. { loop through all lines in in and out
  289. if they're the same, copy the line
  290. else overwrite }
  291. liIndex := 0;
  292. liMaxIndex := Max(lcSourceLines.Count, lcDestLines.Count);
  293. while (liIndex < liMaxIndex) do
  294. begin
  295. if liIndex < lcSourceLines.Count then
  296. lsSourceLine := lcSourceLines[liIndex]
  297. else
  298. lsSourceLine := '';
  299. if liIndex < lcDestLines.Count then
  300. lsDestLine := lcDestLines[liIndex]
  301. else
  302. lsDestLine := '';
  303. liSourcePos := liSourcePos + Length(lsSourceLine);
  304. //liDestPos := liDestPos + Length(lsDestLine);
  305. if AnsiSameStr(lsSourceLine, lsDestLine) then
  306. begin
  307. // the line is the same, copy it
  308. lciEditorWriter.CopyTo(liSourcePos);
  309. end
  310. else
  311. begin
  312. // the line is different, replace it
  313. lciEditorWriter.DeleteTo(liSourcePos);
  314. if lsDestLine <> '' then
  315. lciEditorWriter.Insert(PAnsiChar(AnsiString(lsDestLine)));
  316. end;
  317. inc(liIndex);
  318. end;
  319. // clear off identical text at the end
  320. for liIndex := 0 to lcSameEnd.Count - 1 do
  321. begin
  322. liSourcePos := liSourcePos + Length(lcSameEnd[liIndex]);
  323. end;
  324. lciEditorWriter.CopyTo(liSourcePos);
  325. finally
  326. lcSourceLines.Free;
  327. lcDestLines.Free;
  328. lcSameStart.Free;
  329. lcSameEnd.Free;
  330. end;
  331. end;
  332. {$endif}
  333. procedure TEditorConverter.AfterConvert;
  334. begin
  335. FinalSummary;
  336. Log.CloseLog;
  337. if GetRegSettings.ViewLogAfterRun then
  338. GetRegSettings.ViewLog;
  339. end;
  340. procedure TEditorConverter.Clear;
  341. begin
  342. fcConverter.Clear;
  343. end;
  344. function TEditorConverter.ConvertError: Boolean;
  345. begin
  346. Result := fcConverter.ConvertError;
  347. end;
  348. function TEditorConverter.GetOnStatusMessage: TStatusMessageProc;
  349. begin
  350. Result := fOnStatusMessage;
  351. end;
  352. function TEditorConverter.OriginalFileName: string;
  353. begin
  354. if fsCurrentUnitName <> '' then
  355. Result := fsCurrentUnitName
  356. else
  357. Result := 'IDE';
  358. end;
  359. procedure TEditorConverter.SendStatusMessage(const psUnit, psMessage: string;
  360. const peMessageType: TStatusMessageType;
  361. const piY, piX: integer);
  362. var
  363. lsUnit: string;
  364. begin
  365. lsUnit := psUnit;
  366. if lsUnit = '' then
  367. lsUnit := OriginalFileName;
  368. if Assigned(fOnStatusMessage) then
  369. fOnStatusMessage(lsUnit, psMessage, peMessageType, piY, piX);
  370. end;
  371. procedure TEditorConverter.SetOnStatusMessage(const Value: TStatusMessageProc);
  372. begin
  373. fOnStatusMessage := Value;
  374. end;
  375. function TEditorConverter.TokenCount: integer;
  376. begin
  377. Result := fcConverter.TokenCount;
  378. end;
  379. procedure TEditorConverter.FinalSummary;
  380. var
  381. lsMessage: string;
  382. begin
  383. if fiConvertCount = 0 then
  384. begin
  385. if ConvertError then
  386. lsMessage := 'Aborted due to error'
  387. else
  388. lsMessage := 'Nothing done';
  389. end
  390. {
  391. else if fbAbort then
  392. lsMessage := 'Aborted after ' + DescribeFileCount(fiConvertCount)
  393. }
  394. else if fiConvertCount > 1 then
  395. lsMessage := 'Finished processing ' + DescribeFileCount(fiConvertCount)
  396. else
  397. lsMessage := '';
  398. if lsMessage <> '' then
  399. SendStatusMessage('', lsMessage, mtFinalSummary, -1, -1);
  400. Log.EmptyLine;
  401. Log.Write(lsMessage);
  402. end;
  403. procedure TEditorConverter.BeforeConvert;
  404. begin
  405. fiConvertCount := 0;
  406. end;
  407. end.