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