1 {
2 /***************************************************************************
3                            encloseselectiondlg.pas
4                            -----------------------
5 
6  ***************************************************************************/
7 
8  ***************************************************************************
9  *                                                                         *
10  *   This source is free software; you can redistribute it and/or modify   *
11  *   it under the terms of the GNU General Public License as published by  *
12  *   the Free Software Foundation; either version 2 of the License, or     *
13  *   (at your option) any later version.                                   *
14  *                                                                         *
15  *   This code is distributed in the hope that it will be useful, but      *
16  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
17  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
18  *   General Public License for more details.                              *
19  *                                                                         *
20  *   A copy of the GNU General Public License is available on the World    *
21  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
22  *   obtain it by writing to the Free Software Foundation,                 *
23  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
24  *                                                                         *
25  ***************************************************************************
26 
27   Author: Mattias Gaertner
28 
29   Abstract: Dialog to setup parameters of the enclose selection function
30 }
31 unit EncloseSelectionDlg;
32 
33 {$mode objfpc}{$H+}
34 
35 interface
36 
37 uses
38   Classes, SysUtils,
39   // LCL
40   Forms, Controls, Graphics, Dialogs, ExtCtrls, ButtonPanel,
41   // LazUtils
42   LazUTF8, LazTracer, LazStringUtils,
43   // CodeTools
44   BasicCodeTools, CodeToolManager, SourceChanger,
45   // IDE
46   LazarusIDEStrConsts;
47 
48 type
49   TEncloseSelectionType = (
50     estTryFinally,
51     estTryExcept,
52     estBeginEnd,
53     estForBeginEnd,
54     estWhileDoBeginEnd,
55     estRepeatUntil,
56     estWith,
57     estPascalComment,
58     estRegionArea
59     );
60 
61   { TEncloseSelectionDialog }
62 
63   TEncloseSelectionDialog = class(TForm)
64     ButtonPanel: TButtonPanel;
65     TypeRadiogroup: TRADIOGROUP;
66     procedure EncloseSelectionDialogCREATE(Sender: TObject);
67   private
68   public
GetEncloseTypenull69     function GetEncloseType: TEncloseSelectionType;
70   end;
71 
ShowEncloseSelectionDialognull72 function ShowEncloseSelectionDialog(out TheType: TEncloseSelectionType
73                                     ): TModalResult;
EncloseSelectionTypeDescriptionnull74 function EncloseSelectionTypeDescription(TheType: TEncloseSelectionType
75                                          ): string;
76 procedure GetEncloseSelectionParams(TheType: TEncloseSelectionType;
77                                     out Template: string);
78 procedure EncloseTextSelection(const Template: string; Source: TStrings;
79                                SelectionStart, SelectionEnd: TPoint;
80                                out NewSelection: string; out NewCursor: TPoint);
81 
82 implementation
83 
84 {$R *.lfm}
85 
EncloseSelectionTypeDescriptionnull86 function EncloseSelectionTypeDescription(TheType: TEncloseSelectionType): string;
87 begin
88   Result:='';
89   case TheType of
90     estTryFinally: Result:='Try..Finally';
91     estTryExcept: Result:='Try..Except';
92     estBeginEnd: Result:='Begin..End';
93     estForBeginEnd: Result:='For | do begin..end';
94     estWhileDoBeginEnd: Result:='While | do begin..end';
95     estRepeatUntil: Result:='Repeat..Until |';
96     estWith: Result:='With | do begin..end';
97     estPascalComment: Result:='{..}';
98     estRegionArea: Result:='{$REGION ''|''}..{$ENDREGION}';
99   else
100     RaiseGDBException('EncloseSelectionTypeDescription');
101   end;
102 end;
103 
ShowEncloseSelectionDialognull104 function ShowEncloseSelectionDialog(out TheType: TEncloseSelectionType
105   ): TModalResult;
106 var
107   TheDialog: TEncloseSelectionDialog;
108 begin
109   TheType:=estBeginEnd;
110   TheDialog:=TEncloseSelectionDialog.Create(nil);
111   Result:=TheDialog.ShowModal;
112   if Result=mrOk then
113     TheType:=TheDialog.GetEncloseType;
114   TheDialog.Free;
115 end;
116 
117 procedure GetEncloseSelectionParams(TheType: TEncloseSelectionType; out
118   Template: string);
119 begin
120   case TheType of
121     estTryFinally:
122       Template:='try'+LineEnding
123                +'  <selection>'+LineEnding
124                +'finally'+LineEnding
125                +'  |'+LineEnding
126                +'end;'+LineEnding;
127 
128     estTryExcept:
129       Template:='try'+LineEnding
130                +'  <selection>'+LineEnding
131                +'except'+LineEnding
132                +'  |'+LineEnding
133                +'end;'+LineEnding;
134 
135     estBeginEnd:
136       Template:='begin'+LineEnding
137                +'  |<selection>'+LineEnding
138                +'end;'+LineEnding;
139 
140     estForBeginEnd:
141       Template:='for | do begin'+LineEnding
142                +'  <selection>'+LineEnding
143                +'end;'+LineEnding;
144 
145     estWhileDoBeginEnd:
146       Template:='while | do begin'+LineEnding
147                +'  <selection>'+LineEnding
148                +'end;'+LineEnding;
149 
150     estRepeatUntil:
151       Template:='repeat'+LineEnding
152                +'  <selection>'+LineEnding
153                +'until |;'+LineEnding;
154 
155     estWith:
156       Template:='with | do begin'+LineEnding
157                +'  <selection>'+LineEnding
158                +'end;'+LineEnding;
159 
160     estPascalComment:
161       Template:='{'+LineEnding
162                +'  |<selection>'+LineEnding
163                +'}'+LineEnding;
164 
165     estRegionArea:
166       Template:='{$REGION ''|''}'+LineEnding
167                +'  <selection>'+LineEnding
168                +'{$ENDREGION}'+LineEnding;
169 
170   else
171     RaiseGDBException('GetEnclosedSelectionParams');
172   end;
173 end;
174 
175 procedure EncloseTextSelection(const Template: string; Source: TStrings;
176   SelectionStart, SelectionEnd: TPoint; out NewSelection: string; out
177   NewCursor: TPoint);
178 var
179   TemplateLen: Integer;
180   TemplatePos: Integer;
181   LastWrittenTemplatePos: Integer;
182   NewSelect: TMemoryStream;
183   Y: Integer;
184   X: Integer;
185   OldSelectionIndent: Integer;
186   TemplateIndent: Integer;
187   CutLastLineBreak: Boolean;
188   CutPos: Integer;
189 
190   procedure AddBeautified(const s: string);
191   var
192     NewStr: String;
193     LengthOfLastLine: integer;
194     LineEndCnt: Integer;
195     CurIndent: Integer;
196     FirstLineIndent: Integer;
197     EndPos: Integer;
198   begin
199     if s='' then exit;
200     NewStr:=s;
201     CurIndent:=OldSelectionIndent;
202     if NewSelect.Position=0 then begin
203       FirstLineIndent:=OldSelectionIndent-SelectionStart.X+1;
204       if FirstLineIndent<0 then FirstLineIndent:=0;
205       NewStr:=GetIndentStr(FirstLineIndent)+NewStr;
206       dec(CurIndent,FirstLineIndent);
207       if CurIndent<0 then CurIndent:=0;
208     end;
209     //debugln('AddBeautified A X=',X,' Y=',Y,' CurIndent=',CurIndent,' NewStr="',NewStr,'"');
210     dec(CurIndent,GetLineIndent(NewStr,1));
211     if CurIndent<0 then CurIndent:=0;
212     NewStr:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
213                 NewStr,CurIndent,
214                 [bcfIndentExistingLineBreaks,bcfDoNotIndentFirstLine]);
215     LineEndCnt:=LineEndCount(NewStr,LengthOfLastLine);
216     if (TemplatePos>TemplateLen) then begin
217       // cut indent at end of template
218       if LineEndCnt>0 then begin
219         EndPos:=length(NewStr);
220         while (EndPos>=1) and (NewStr[EndPos]=' ') do dec(EndPos);
221         NewStr:=copy(NewStr,1,length(NewStr)-CurIndent);
222         LineEndCnt:=LineEndCount(NewStr,LengthOfLastLine);
223       end;
224     end;
225     inc(Y,LineEndCnt);
226     if LineEndCnt=0 then
227       inc(X,LengthOfLastLine)
228     else
229       X:=LengthOfLastLine+1;
230     if (LineEndCnt>0) or (NewSelect.Position=0) then
231       TemplateIndent:=GetLineIndent(NewStr,length(NewStr)+1);
232     //debugln('AddBeautified B X=',X,' Y=',Y,' TemplateIndent=',TemplateIndent,' LengthOfLastLine=',LengthOfLastLine,' NewStr="',NewSTr,'"');
233     NewSelect.Write(NewStr[1],length(NewStr));
234   end;
235 
236   procedure FlushTemplate;
237   var
238     FromPos: Integer;
239     ToPos: Integer;
240   begin
241     FromPos:=LastWrittenTemplatePos+1;
242     ToPos:=TemplatePos-1;
243     if ToPos>TemplateLen then ToPos:=TemplateLen;
244     if FromPos<=ToPos then
245       AddBeautified(copy(Template,FromPos,ToPos-FromPos+1));
246     LastWrittenTemplatePos:=ToPos;
247   end;
248 
249   procedure CalculateCursorPos;
250   begin
251     NewCursor:=Point(X,Y);
252   end;
253 
254   procedure InsertSelection;
255   var
256     CurY: Integer;
257     CurLine: string;
258     IndentStr: String;
259     MinX: Integer;
260     MaxX: Integer;
261     l: Integer;
262   begin
263     IndentStr:=GetIndentStr(TemplateIndent-OldSelectionIndent);
264     for CurY:=SelectionStart.Y to SelectionEnd.Y do begin
265       CurLine:=Source[CurY-1];
266       //debugln(['InsertSelection CurY=',CurY,' CurLine="',dbgstr(CurLine),'"']);
267       MinX:=1;
268       MaxX:=length(CurLine)+1;
269       if (CurY=SelectionStart.Y) then begin
270         MinX:=SelectionStart.X;
271         if MinX<=OldSelectionIndent then
272           MinX:=OldSelectionIndent+1;
273         if MinX>MaxX then
274           MinX:=MaxX;
275       end;
276       if (CurY=SelectionEnd.Y) and (MaxX>SelectionEnd.X) then
277         MaxX:=SelectionEnd.X;
278       //debugln(['InsertSelection CurY=',CurY,' Range=',MinX,'-',MaxX,' Indent="',length(IndentStr),'" "',copy(CurLine,MinX,MaxX-MinX),'"']);
279       X:=1;
280       // write indent
281       if (IndentStr<>'') and (CurY<>SelectionStart.Y) then begin
282         NewSelect.Write(IndentStr[1],length(IndentStr));
283         inc(X,length(IndentStr));
284       end;
285       // write line
286       l:=MaxX-MinX;
287       if l>0 then begin
288         NewSelect.Write(CurLine[MinX],l);
289         inc(X,l);
290       end;
291       // write line break and adjust cursor
292       if CurY<SelectionEnd.Y then begin
293         NewSelect.Write(EndOfLine[1],length(EndOfLine));
294         inc(Y);
295         X:=1;
296       end;
297     end;
298   end;
299 
300   procedure ParseMacro;
301   var
302     MacroNameStart: Integer;
303     MacroNameEnd: Integer;
304 
MacroNameIsnull305     function MacroNameIs(const Name: string): boolean;
306     begin
307       Result:=CompareText(@Template[MacroNameStart],MacroNameEnd-MacroNameStart,
308                           @Name[1],length(Name),false)=0;
309     end;
310 
311   begin
312     FlushTemplate;
313     inc(TemplatePos);
314     MacroNameStart:=TemplatePos;
315     while (TemplatePos<=TemplateLen)
316     and (Template[TemplatePos] in ['a'..'z','A'..'Z','_','0'..'9']) do
317       inc(TemplatePos);
318     MacroNameEnd:=TemplatePos;
319     if (TemplatePos<=TemplateLen) and (Template[TemplatePos]='>') then begin
320       LastWrittenTemplatePos:=TemplatePos;
321       inc(TemplatePos);
322       if MacroNameIs('Selection') then begin
323         InsertSelection;
324       end;
325     end;
326   end;
327 
328   procedure GetOldSelectionIndent;
329   var
330     CurY: Integer;
331     CurLine: string;
332     CurIndent: Integer;
333   begin
334     OldSelectionIndent:=0;
335     CurY:=SelectionStart.Y;
336     while CurY<Source.Count do begin
337       CurLine:=Source[CurY-1];
338       CurIndent:=GetLineIndent(CurLine,1);
339       if CurIndent<length(CurLine) then begin
340         OldSelectionIndent:=CurIndent;
341         break;
342       end;
343       inc(CurY);
344     end;
345   end;
346 
347 begin
348   //debugln(['EncloseTextSelection A ',SelectionStart.X,',',SelectionStart.Y,'-',SelectionEnd.X,',',SelectionEnd.Y,' indent=',Indent,' Template="',Template,'"']);
349   NewSelection:='';
350   NewCursor:=Point(0,0);
351   CutLastLineBreak:=true;
352   if (SelectionEnd.X=1) and (SelectionEnd.Y>SelectionStart.Y) then begin
353     CutLastLineBreak:=false;
354     dec(SelectionEnd.Y);
355     if SelectionEnd.Y<Source.Count then
356       SelectionEnd.X:=length(Source[SelectionEnd.Y-1])+1;
357   end;
358   NewSelect:=TMemoryStream.Create;
359   NewCursor:=SelectionStart;
360   X:=NewCursor.X;
361   Y:=NewCursor.Y;
362   GetOldSelectionIndent;
363   TemplateIndent:=OldSelectionIndent;
364   try
365     TemplateLen:=length(Template);
366     TemplatePos:=1;
367     LastWrittenTemplatePos:=TemplatePos-1;
368     while TemplatePos<=TemplateLen do begin
369       case Template[TemplatePos] of
370         '\':
371           begin
372             FlushTemplate;
373             LastWrittenTemplatePos:=TemplatePos;
374             inc(TemplatePos,2);
375           end;
376 
377         '|':
378           begin
379             FlushTemplate;
380             CalculateCursorPos;
381             LastWrittenTemplatePos:=TemplatePos;
382             inc(TemplatePos);
383           end;
384 
385         '<':
386           ParseMacro;
387 
388       else
389         inc(TemplatePos);
390       end;
391     end;
392     FlushTemplate;
393   finally
394     SetLength(NewSelection,NewSelect.Size);
395     if NewSelection<>'' then begin
396       NewSelect.Position:=0;
397       NewSelect.Read(NewSelection[1],length(NewSelection));
398       //debugln(['EncloseTextSelection CutLastLineBreak=',CutLastLineBreak,' NewSelection="',NewSelection,'"']);
399       if CutLastLineBreak then begin
400         CutPos:=length(NewSelection);
401         if NewSelection[CutPos] in [#10,#13] then begin
402           dec(CutPos);
403           if (CutPos>=1) and (NewSelection[CutPos] in [#10,#13])
404           and (NewSelection[CutPos]<>NewSelection[CutPos+1]) then begin
405             dec(CutPos);
406           end;
407           NewSelection:=copy(NewSelection,1,CutPos);
408         end;
409       end;
410     end;
411     NewSelect.Free;
412   end;
413 end;
414 
415 { TEncloseSelectionDialog }
416 
417 procedure TEncloseSelectionDialog.EncloseSelectionDialogCREATE(Sender: TObject);
418 var
419   t: TEncloseSelectionType;
420 begin
421   Caption:=lisKMEncloseSelection;
422 
423   TypeRadiogroup.Caption:=lisChooseStructureToEncloseSelection;
424   with TypeRadiogroup.Items do begin
425     BeginUpdate;
426     for t:=Low(TEncloseSelectionType) to High(TEncloseSelectionType) do
427       Add(EncloseSelectionTypeDescription(t));
428     EndUpdate;
429   end;
430   TypeRadiogroup.ItemIndex:=0;
431 end;
432 
GetEncloseTypenull433 function TEncloseSelectionDialog.GetEncloseType: TEncloseSelectionType;
434 var
435   i: Integer;
436 begin
437   i:=TypeRadiogroup.ItemIndex;
438   for Result:=Low(TEncloseSelectionType) to High(TEncloseSelectionType) do
439     if UTF8CompareLatinTextFast(TypeRadiogroup.Items[i],
440                                 EncloseSelectionTypeDescription(Result))=0
441     then
442       exit;
443   RaiseGDBException('TEncloseSelectionDialog.GetEncloseType');
444 end;
445 
446 end.
447 
448