1 {
2 /***************************************************************************
3                              sourceeditprocs.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   Support functions and types for the source editor.
28 
29 }
30 unit SourceEditProcs;
31 
32 {$mode objfpc}{$H+}
33 
34 {$I ide.inc}
35 
36 interface
37 
38 uses
39   Classes, SysUtils, RegExpr,
40   // LCL
41   LCLType, Graphics, Controls,
42   // LazUtils
43   LazFileUtils, LazStringUtils,
44   // SynEdit
45   SynCompletion,
46   // CodeTools
47   BasicCodeTools, CodeTree, CodeAtom, CodeCache, SourceChanger, CustomCodeTool,
48   CodeToolManager, PascalParserTool, KeywordFuncLists, FileProcs,
49   IdentCompletionTool, PascalReaderTool,
50   // IdeIntf
51   LazIDEIntf, IDEImagesIntf, TextTools, IDETextConverter,
52   // IDE
53   DialogProcs, EditorOptions, CodeToolsOptions;
54 
55 type
56 
57   { TLazTextConverterToolClasses }
58 
59   TLazTextConverterToolClasses = class(TTextConverterToolClasses)
60   public
GetTempFilenamenull61     function GetTempFilename: string; override;
SupportsTypenull62     function SupportsType({%H-}aTextType: TTextConverterType): boolean; override;
LoadFromFilenull63     function LoadFromFile(Converter: TIDETextConverter; const AFilename: string;
64                           UpdateFromDisk, Revert: Boolean): Boolean; override;
SaveCodeBufferToFilenull65     function SaveCodeBufferToFile(Converter: TIDETextConverter;
66                            const AFilename: string): Boolean; override;
GetCodeBufferSourcenull67     function GetCodeBufferSource(Converter: TIDETextConverter;
68                                  out Source: string): boolean; override;
CreateCodeBuffernull69     function CreateCodeBuffer({%H-}Converter: TIDETextConverter;
70                               const Filename, NewSource: string;
71                               out CodeBuffer: Pointer): boolean; override;
LoadCodeBufferFromFilenull72     function LoadCodeBufferFromFile({%H-}Converter: TIDETextConverter;
73                                    const Filename: string;
74                                    UpdateFromDisk, Revert: Boolean;
75                                    out CodeBuffer: Pointer): boolean; override;
76     procedure AssignCodeToolBossError(Target: TCustomTextConverterTool); override;
77   end;
78 
79   TLazIdentifierListItem = class(TIdentifierListItem)
80   private
81     FBeautified: Boolean;
82   public
83     procedure BeautifyIdentifier({%H-}IdentList: TIdentifierList); override;
84   end;
85 
86   TLazUnitNameSpaceIdentifierListItem = class(TUnitNameSpaceIdentifierListItem)
87   private
88     FBeautified: Boolean;
89   public
90     procedure BeautifyIdentifier(IdentList: TIdentifierList); override;
91   end;
92 
93   TCodeTemplateIdentifierListItem = class(TIdentifierListItem)
94   public
95     Comment: string;
96   end;
97 
98 procedure SetupTextConverters;
99 procedure FreeTextConverters;
100 
101 type
102   TCompletionType = (
103     ctNone, ctWordCompletion, ctTemplateCompletion, ctIdentCompletion);
104   TIdentComplValue = (
105     icvIdentifier,
106     icvProcWithParams,
107     icvIndexedProp,
108     icvCompleteProcDeclaration,
109     icvUnitName,
110     icvNone
111     );
112 
113   TPaintCompletionItemColors = record
114     BackgroundColor: TColor;
115     BackgroundSelectedColor: TColor;
116     TextColor: TColor;
117     TextSelectedColor: TColor;
118     TextHilightColor: TColor;
119   end;
120   PPaintCompletionItemColors = ^TPaintCompletionItemColors;
121 
122 // completion form and functions
PaintCompletionItemnull123 function PaintCompletionItem(const AKey: string; ACanvas: TCanvas;
124   X, Y, MaxX: integer; ItemSelected: boolean; Index: integer;
125   {%H-}aCompletion : TSynCompletion; CurrentCompletionType: TCompletionType;
126   Highlighter: TSrcIDEHighlighter; Colors: PPaintCompletionItemColors;
127   MeasureOnly: Boolean = False): TPoint;
128 
GetIdentCompletionValuenull129 function GetIdentCompletionValue(aCompletion : TSynCompletion;
130   AddChar: TUTF8Char;
131   out ValueType: TIdentComplValue; out CursorToLeft: integer): string;
BreakLinesInTextnull132 function BreakLinesInText(const s: string; MaxLineLength: integer): string;
133 
134 const
135   ctnWord = ctnUser + 1;
136   ctnCodeTemplate = ctnUser + 2;
137   WordCompatibility = icompUnknown;
138   CodeTemplateCompatibility = icompUnknown;
139   CodeTemplateHistoryIndex = High(Integer);
140   CodeTemplateLevel = High(Integer);
141 
142 implementation
143 
144 var
145   SynREEngine: TRegExpr;
146 
147 procedure SetupTextConverters;
148 begin
149   TextConverterToolClasses:=TLazTextConverterToolClasses.Create;
150   TextConverterToolClasses.RegisterClass(TTextReplaceTool);
151 end;
152 
153 procedure FreeTextConverters;
154 begin
155   FreeAndNil(TextConverterToolClasses);
156 end;
157 
PaintCompletionItemnull158 function PaintCompletionItem(const AKey: string; ACanvas: TCanvas; X, Y,
159   MaxX: integer; ItemSelected: boolean; Index: integer;
160   aCompletion: TSynCompletion; CurrentCompletionType: TCompletionType;
161   Highlighter: TSrcIDEHighlighter; Colors: PPaintCompletionItemColors;
162   MeasureOnly: Boolean): TPoint;
163 
164 const
165   HintModifierImage: array[TPascalHintModifier] of String = (
166  { phmDeprecated    } 'ce_deprecated',
167  { phmPlatform      } 'ce_platform',
168  { phmLibrary       } 'ce_library',
169  { phmUnimplemented } 'ce_unimplemented',
170  { phmExperimental  } 'ce_experimental'
171   );
172 
173 var
174   BGRed: Integer;
175   BGGreen: Integer;
176   BGBlue: Integer;
177   TokenStart: Integer;
178   BackgroundColor: TColor;
179   ForegroundColor: TColor;
180   TextHilightColor: TColor;
181   AllowFontColor: Boolean;
182 
183   procedure SetFontColor(NewColor: TColor; Force: boolean = false);
184 
185     {procedure IncreaseDiff(var Value: integer; BaseValue: integer);
186     begin
187       if Value<BaseValue then begin
188         dec(Value,$80);
189       end else begin
190         inc(Value,$80);
191       end;
192       if (Value<0) or (Value>$ff) then begin
193         if BaseValue<$80 then
194           Value:=$ff
195         else
196           Value:=0;
197       end;
198     end;}
199 
200   var
201     FGRed: Integer;
202     FGGreen: Integer;
203     FGBlue: Integer;
204     RedDiff: integer;
205     GreenDiff: integer;
206     BlueDiff: integer;
207   begin
208     if (not AllowFontColor) and (not Force) then
209       Exit;
210 
211     NewColor := TColor(ColorToRGB(NewColor));
212     FGRed:=(NewColor shr 16) and $ff;
213     FGGreen:=(NewColor shr 8) and $ff;
214     FGBlue:=NewColor and $ff;
215     RedDiff:=Abs(FGRed-BGRed);
216     GreenDiff:=Abs(FGGreen-BGGreen);
217     BlueDiff:=Abs(FGBlue-BGBlue);
218     {if ItemSelected then
219       writeln('SetFontColor ',RedDiff,'=',FGRed,'-',BGRed,' ',
220          GreenDiff,'=',FGGreen,'-',BGGreen,' ',
221          BlueDiff,'=',FGBlue,'-',BGBlue);}
222     if RedDiff*RedDiff + GreenDiff*GreenDiff + BlueDiff*BlueDiff<30000 then
223     begin
224       NewColor:=InvertColor(NewColor);
225       {IncreaseDiff(FGRed,BGRed);
226       IncreaseDiff(FGGreen,BGGreen);
227       IncreaseDiff(FGBlue,BGBlue);
228       NewColor:=(FGRed shl 16) or (FGGreen shl 8) or FGBlue;}
229     end;
230     ACanvas.Font.Color:=NewColor;
231     //debugln(['SetFontColor ',NewColor,' ',ACanvas.Font.Color]);
232   end;
233 
234   procedure WriteToken(var TokenStart, TokenEnd: integer);
235   var
236     CurToken: String;
237   begin
238     if TokenStart>=1 then begin
239       CurToken:=copy(AKey,TokenStart,TokenEnd-TokenStart);
240       if MeasureOnly then
241         Inc(Result.X, ACanvas.TextWidth(CurToken))
242       else begin
243         //debugln(['WriteToken ',CurToken,' ',ACanvas.Font.Color]);
244         ACanvas.TextOut(x+1, y, CurToken);
245       end;
246       x := x + ACanvas.TextWidth(CurToken);
247       //debugln('Paint A Text="',CurToken,'" x=',dbgs(x),' y=',dbgs(y),' "',ACanvas.Font.Name,'" ',dbgs(ACanvas.Font.Height),' ',dbgs(ACanvas.TextWidth(CurToken)));
248       TokenStart:=0;
249     end;
250   end;
251 
252   procedure PaintHighlighted(s: string);
253   var
254     sToken: PChar;
255     nTokenLen: integer;
256     Attr: TSynHighlightElement;
257     CurForeground: TColor;
258     LeftText: string;
259   begin
260     if MeasureOnly then begin
261       Inc(Result.X,ACanvas.TextWidth(s));
262       exit;
263     end;
264     if (Highlighter<>nil) and AllowFontColor then begin
265       LeftText := '';
266       Highlighter.ResetRange;
267       Highlighter.SetLine(s,0);
268       while not Highlighter.GetEol do begin
269         Highlighter.GetTokenEx(sToken,nTokenLen);
270         SetLength(s,nTokenLen);
271         if nTokenLen>0 then begin
272           System.Move(sToken^,s[1],nTokenLen);
273           attr := Highlighter.GetTokenAttribute;
274           CurForeground:=Attr.Foreground;
275           if CurForeground=clNone then
276             CurForeground:=TColor(ForegroundColor);
277           SetFontColor(CurForeground);
278           ACanvas.TextOut(x+1+ACanvas.TextWidth(LeftText),y,s);
279           LeftText += s;
280         end;
281         Highlighter.Next;
282       end;
283     end else begin
284       SetFontColor(ForegroundColor);
285       ACanvas.TextOut(x+1,y,s);
286     end;
287   end;
288 
289 var
290   i: Integer;
291   s: string;
292   IdentItem: TIdentifierListItem;
293   AColor: TColor;
294   ANode: TCodeTreeNode;
295   ItemNode: TCodeTreeNode;
296   SubNode: TCodeTreeNode;
297   IsReadOnly: boolean;
298   UseImages: boolean;
299   ImageIndex, ImageIndexCC: longint;
300   Token: String;
301   PrefixPosition: Integer;
302   HintModifiers: TPascalHintModifiers;
303   HintModifier: TPascalHintModifier;
304   HelperForNode: TCodeTreeNode;
305 begin
306   if Colors<>nil then
307   begin
308     if ItemSelected then
309     begin
310       AllowFontColor := Colors^.TextSelectedColor=clNone;
311       if AllowFontColor then
312         ForegroundColor := ColorToRGB(Colors^.TextColor)
313       else
314         ForegroundColor := ColorToRGB(Colors^.TextSelectedColor);
315       BackgroundColor:=ColorToRGB(Colors^.BackgroundSelectedColor);
316     end else
317     begin
318       ForegroundColor := ColorToRGB(Colors^.TextColor);
319       AllowFontColor := True;
320       BackgroundColor:=ColorToRGB(Colors^.BackgroundColor);
321     end;
322     TextHilightColor:=ColorToRGB(Colors^.TextHilightColor);
323   end else
324   begin
325     ForegroundColor := clBlack;
326     AllowFontColor := True;
327     BackgroundColor:=ColorToRGB(ACanvas.Brush.Color);
328     TextHilightColor := clWhite;
329   end;
330 
331   BGRed:=(BackgroundColor shr 16) and $ff;
332   BGGreen:=(BackgroundColor shr 8) and $ff;
333   BGBlue:=BackgroundColor and $ff;
334   ForegroundColor := ColorToRGB(ForegroundColor);
335   SetFontColor(ForegroundColor,true);
336 
337   Result.X := 0;
338   Result.Y := ACanvas.TextHeight('W');
339   if CurrentCompletionType=ctIdentCompletion then begin
340     // draw
341     IdentItem:=CodeToolBoss.IdentifierList.FilteredItems[Index];
342     if IdentItem=nil then begin
343       if not MeasureOnly then
344         ACanvas.TextOut(x+1, y, 'PaintCompletionItem: BUG in codetools or misuse of PaintCompletionItem');
345       exit;
346     end;
347     IdentItem.BeautifyIdentifier(CodeToolBoss.IdentifierList);
348     ItemNode:=IdentItem.Node;
349     ImageIndex:=-1;
350     ImageIndexCC := -1;
351     UseImages := CodeToolsOpts.IdentComplShowIcons;
352 
353     // first write the type
354     // var, procedure, property, function, type, const
355     case IdentItem.GetDesc of
356 
357     ctnVarDefinition, ctnRecordCase:
358       begin
359         if UseImages then
360           ImageIndexCC := IDEImages.LoadImage('cc_variable', 16)
361         else begin
362           AColor:=clMaroon;
363           s:='var';
364         end;
365       end;
366 
367     ctnTypeDefinition, ctnEnumerationType:
368       begin
369         if UseImages then
370         begin
371           if ItemNode <> nil then
372             begin
373               ANode := IdentItem.Tool.FindTypeNodeOfDefinition(ItemNode);
374               case ANode.Desc of
375                 ctnClass:
376                   ImageIndexCC := IDEImages.LoadImage('cc_class', 16);
377                 ctnRecordType:
378                   ImageIndexCC := IDEImages.LoadImage('cc_record', 16);
379                 ctnEnumerationType:
380                   ImageIndexCC := IDEImages.LoadImage('cc_enum', 16);
381                 else
382                   ImageIndexCC := IDEImages.LoadImage('cc_type', 16);
383               end;
384             end
385           else
386             ImageIndexCC := IDEImages.LoadImage('cc_type', 16);
387         end
388         else
389         begin
390           AColor:=clLime;
391           s:='type';
392         end;
393       end;
394 
395     ctnConstDefinition,ctnConstant:
396       begin
397         AColor:=clOlive;
398         s:='const';
399         if UseImages then
400           ImageIndexCC := IDEImages.LoadImage('cc_constant', 16);
401       end;
402 
403     ctnProcedure:
404       begin
405         if UseImages then
406         begin
407           if IdentItem.IsFunction then
408             ImageIndexCC := IDEImages.LoadImage('cc_function', 16)
409           else if IdentItem.IsConstructor then
410             ImageIndexCC := IDEImages.LoadImage('cc_constructor', 16)
411           else if IdentItem.IsDestructor then
412             ImageIndexCC := IDEImages.LoadImage('cc_destructor', 16)
413           else
414             ImageIndexCC := IDEImages.LoadImage('cc_procedure', 16);
415         end
416         else
417         begin
thennull418           if IdentItem.IsFunction then
419             begin
420               AColor:=clTeal;
421               s:='function';
422             end
423           else
424             begin
425               AColor:=clNavy;
426               if IdentItem.IsConstructor then
427                 s := 'constructor'
428               else if IdentItem.IsDestructor then
429                 s := 'destructor'
430               else
431                 s:='procedure';
432             end;
433           if IdentItem.TryIsAbstractMethod then
434             AColor:=clRed;
435           if iliHasLowerVisibility in IdentItem.Flags then
436             AColor:=clGray;
437         end;
438       end;
439 
440     ctnProperty,ctnGlobalProperty:
441       begin
442         IsReadOnly:=IdentItem.IsPropertyReadOnly;
443         if UseImages then
444           begin
445             if IsReadOnly then
446               ImageIndexCC := IDEImages.LoadImage('cc_property_ro', 16)
447             else
448               ImageIndexCC := IDEImages.LoadImage('cc_property', 16);
449           end
450         else
451           begin
452             AColor:=clPurple;
453             s:='property';
454             if IsReadOnly then
455               ImageIndex:=IDEImages.LoadImage('ce_property_readonly');
456           end;
457       end;
458 
459     ctnEnumIdentifier:
460       begin
461         if UseImages then
462           ImageIndexCC := IDEImages.LoadImage('cc_enum', 16)
463         else
464           begin
465             AColor:=clOlive;
466             s:='enum';
467           end;
468       end;
469 
470     ctnLabel:
471       begin
472         if UseImages then
473           ImageIndexCC := IDEImages.LoadImage('cc_label', 16)
474         else
475           begin
476             AColor:=clOlive;
477             s:='label';
478           end;
479       end;
480 
481     ctnUnit, ctnUseUnitClearName:
482       begin
483         if UseImages then
484           ImageIndexCC := IDEImages.LoadImage('cc_unit', 16)
485         else
486           begin
487             AColor:=clBlack;
488             s:='unit';
489           end;
490       end;
491 
492     ctnUseUnitNamespace:
493       begin
494         if UseImages then
495           ImageIndexCC := IDEImages.LoadImage('cc_namespace', 16)
496         else
497           begin
498             AColor:=clBlack;
499             s:='namespace';
500           end;
501       end;
502 
503     ctnWord:
504       begin
505         AColor:=clGray;
506         s:='text';
507       end;
508 
509     ctnCodeTemplate:
510       begin
511         AColor:=clGray;
512         s:='template';
513       end;
514 
515     ctnNone:
516       if not UseImages then
517       begin
518         if iliKeyword in IdentItem.Flags then begin
519           AColor:=clBlack;
520           s:='keyword';
521         end else begin
522           AColor:=clGray;
523           s:='';
524         end;
525       end;
526 
527     else
528       AColor:=clGray;
529       s:='';
530     end;
531 
532     if UseImages then
533     begin
534      // drawing type image
535       if MeasureOnly then
536         Inc(Result.X, IDEImages.Images_16.Width + round(IDEImages.Images_16.Width / 4))
537       else
538         begin
539           if ImageIndexCC >= 0 then
540             IDEImages.Images_16.Draw(ACanvas, x+1, y+(Result.Y-IDEImages.Images_16.Height) div 2, ImageIndexCC);
541         end;
542       Inc(x,IDEImages.Images_16.Width + round(IDEImages.Images_16.Width / 4));
543     end
544     else
545     begin
546       SetFontColor(AColor);
547       if MeasureOnly then
548         Inc(Result.X, ACanvas.TextWidth('constructor '))
549       else
550         ACanvas.TextOut(x+1,y,s);
551       inc(x,ACanvas.TextWidth('constructor '));
552     end;
553 
554     if x>MaxX then exit;
555 
556     // paint the identifier
557     SetFontColor(ForegroundColor);
558     ACanvas.Font.Style:=ACanvas.Font.Style+[fsBold];
559     s:=IdentItem.Identifier;
560     if MeasureOnly then
561       Inc(Result.X, 1+ACanvas.TextWidth(s))
562     else begin
563       //DebugLn(['PaintCompletionItem ',x,',',y,' ',s]);
564       // highlighting the prefix
565       if (Colors<>nil) and (TextHilightColor<>clNone)
566       and (aCompletion.CurrentString<>'') then
567       begin
568         PrefixPosition := PosI(aCompletion.CurrentString, s);
569         if PrefixPosition > 0 then
570         begin
571           // paint before prefix
572           Token := Copy(s, 1, PrefixPosition-1);
573           ACanvas.TextOut(x+1,y,Token);
574           // paint highlight prefix
575           SetFontColor(TextHilightColor);
576           Token := Copy(s, PrefixPosition, Length(aCompletion.CurrentString));
577           ACanvas.TextOut(x+1+ACanvas.TextWidth(Copy(s, 1, PrefixPosition-1)),y,Token);
578           // paint after prefix
579           SetFontColor(ForegroundColor);
580           Token := Copy(s, PrefixPosition+Length(aCompletion.CurrentString), High(Integer));
581           ACanvas.TextOut(x+1+ACanvas.TextWidth(Copy(s, 1, PrefixPosition-1+Length(aCompletion.CurrentString))),y,Token);
582         end else
583           ACanvas.TextOut(x+1,y,s);
584       end else
585         ACanvas.TextOut(x+1,y,s);
586       inc(x,ACanvas.TextWidth(s)+1);
587       if x>MaxX then exit;
588     end;
589     SetFontColor(ForegroundColor);
590     ACanvas.Font.Style:=ACanvas.Font.Style-[fsBold];
591 
592     if ImageIndex <= 0 then
593     begin
594       HintModifiers := IdentItem.GetHintModifiers;
595       for HintModifier in HintModifiers do
596       begin
597         ImageIndex := IDEImages.LoadImage(HintModifierImage[HintModifier]);
598         break;
599       end;
600     end;
601 
602     // paint icon
603     if not UseImages then
604     begin
605       if ImageIndex>=0 then begin
606         if MeasureOnly then
607           Inc(Result.X, 18)
608         else begin
609           IDEImages.Images_16.Draw(ACanvas,x+1,y+(Result.Y-16) div 2,ImageIndex);
610           inc(x,18);
611           if x>MaxX then exit;
612         end;
613       end;
614     end;
615 
616     // finally paint the type/value/parameters
617     s:='';
618     if ItemNode<>nil then begin
619       case ItemNode.Desc of
620 
621       ctnProcedure:
622         begin
623           s:=IdentItem.Tool.ExtractProcHead(ItemNode,
624             [phpWithoutClassName,phpWithoutName,phpWithVarModifiers,
625              phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
626              phpWithOfObject,phpWithoutSemicolon]);
627         end;
628 
629       ctnProperty,ctnGlobalProperty:
630         begin
631           s:=IdentItem.Tool.ExtractProperty(ItemNode,
632             [phpWithoutName,phpWithVarModifiers,
633              phpWithParameterNames,phpWithDefaultValues,phpWithResultType]);
634         end;
635 
636       ctnVarDefinition:
637         begin
638           ANode:=IdentItem.Tool.FindTypeNodeOfDefinition(ItemNode);
639           s:=' : '+IdentItem.Tool.ExtractNode(ANode,[]);
640         end;
641 
642       ctnTypeDefinition:
643         begin
644           ANode:=IdentItem.Tool.FindTypeNodeOfDefinition(ItemNode);
645           s:=' = ';
646           if (ANode<>nil) then begin
647             case ANode.Desc of
648             ctnClass,ctnObject,ctnObjCClass,ctnObjCCategory,
649             ctnCPPClass,
650             ctnClassInterface,ctnObjCProtocol,ctnDispinterface,
651             ctnClassHelper,ctnRecordHelper,ctnTypeHelper:
652               begin
653                 case ANode.Desc of
654                 ctnClass: s:=s+'class';
655                 ctnClassHelper: s:=s+'class helper';
656                 ctnRecordHelper: s:=s+'record helper';
657                 ctnTypeHelper: s:=s+'type helper';
658                 ctnObject: s:=s+'object';
659                 ctnObjCClass: s:=s+'objcclass';
660                 ctnObjCCategory: s:=s+'objccategory';
661                 ctnCPPClass: s:=s+'cppclass';
662                 ctnClassInterface: s:=s+'interface';
663                 ctnObjCProtocol: s:=s+'objcprotocol';
664                 ctnDispinterface: s:=s+'dispinterface';
665                 end;
666                 try
667                   IdentItem.Tool.BuildSubTree(ANode);
668                 except
669                   on ECodeToolError do ;
670                 end;
671                 if ANode.Desc in [ctnClassHelper, ctnRecordHelper, ctnTypeHelper] then
672                   HelperForNode := IdentItem.Tool.FindHelperForNode(ANode)
673                 else
674                   HelperForNode := nil;
675                 SubNode:=IdentItem.Tool.FindInheritanceNode(ANode);
676                 if SubNode<>nil then
677                   s:=s+IdentItem.Tool.ExtractNode(SubNode,[]);
678                 if HelperForNode<>nil then
679                   s:=s+' '+IdentItem.Tool.ExtractNode(HelperForNode,[]);
680               end;
681             ctnRecordType:
682               s:=s+'record';
683             else
684               s:=s+IdentItem.Tool.ExtractNode(ANode,[]);
685             end;
686           end else
687             s:=s+'?';
688         end;
689 
690       ctnConstDefinition:
691         begin
692           ANode:=IdentItem.Tool.FindTypeNodeOfDefinition(ItemNode);
693           if ANode<>nil then
694             s:=' = '+IdentItem.Tool.ExtractNode(ANode,[])
695           else begin
696             s:=IdentItem.Tool.ExtractCode(ItemNode.StartPos
697                             +GetIdentLen(@IdentItem.Tool.Src[ItemNode.StartPos]),
698                             ItemNode.EndPos,[]);
699           end;
700           s:=copy(s,1,50);
701         end;
702 
703       ctnRecordCase:
704         begin
705           s:=' : '+IdentItem.Tool.ExtractRecordCaseType(ItemNode);
706         end;
707 
708       end;
709     end else begin
710       // IdentItem.Node=nil
711       case IdentItem.GetDesc of
712       ctnProcedure:
713         // predefined procedure (e.g. length)
714         begin
715           s:=IdentItem.ParamNameList;
716           if s<>'' then
717             s:='('+s+')';
thennull718           if IdentItem.IsFunction then
719             s := s + ':' + IdentItem.ResultType;
720           s:=s+';'
721         end;
722       ctnCodeTemplate:
723         begin
724           if IdentItem is TCodeTemplateIdentifierListItem then
725             s:=' - '+TCodeTemplateIdentifierListItem(IdentItem).Comment;
726         end;
727       end;
728     end;
729 
730     if s<>'' then begin
731       inc(x);
732       PaintHighlighted(s);
733     end;
734 
735   end else begin
736     // parse AKey for text and style
737     //debugln(['PaintCompletionItem WordCompletion:']);
738     i := 1;
739     TokenStart:=0;
740     while i <= Length(AKey) do begin
741       case AKey[i] of
742       #1, #2:
743         begin
744           WriteToken(TokenStart,i);
745           // set color
746           ForegroundColor:=(Ord(AKey[i + 3]) shl 8
747                           + Ord(AKey[i + 2])) shl 8
748                           + Ord(AKey[i + 1]);
749           SetFontColor(ForegroundColor);
750           inc(i, 4);
751         end;
752       #3:
753         begin
754           WriteToken(TokenStart,i);
755           // set style
756           case AKey[i + 1] of
757           'B': ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
758           'b': ACanvas.Font.Style := ACanvas.Font.Style - [fsBold];
759           'U': ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline];
760           'u': ACanvas.Font.Style := ACanvas.Font.Style - [fsUnderline];
761           'I': ACanvas.Font.Style := ACanvas.Font.Style + [fsItalic];
762           'i': ACanvas.Font.Style := ACanvas.Font.Style - [fsItalic];
763           end;
764           inc(i, 2);
765         end;
766       else
767         if TokenStart<1 then TokenStart:=i;
768         inc(i);
769       end;
770     end;
771     WriteToken(TokenStart,i);
772   end;
773   //debugln(['PaintCompletionItem END']);
774 end;
775 
GetIdentCompletionValuenull776 function GetIdentCompletionValue(aCompletion : TSynCompletion;
777   AddChar: TUTF8Char;
778   out ValueType: TIdentComplValue; out CursorToLeft: integer): string;
779 var
780   Index: Integer;
781   IdentItem: TIdentifierListItem;
782   IdentList: TIdentifierList;
783   CursorAtEnd: boolean;
784   ProcModifierPos: LongInt;
785   ProcHeadFlags: TProcHeadAttributes;
786   CanAddSemicolon: Boolean;
787   CanAddComma: Boolean;
788   ClassNode: TCodeTreeNode;
789   IsReadOnly: Boolean;
790   Line: string;
791   Indent: LongInt;
792   StartContextPos: TCodeXYPosition;
793   s: String;
794 begin
795   Result:='';
796   CursorToLeft:=0;
797   CursorAtEnd:=true;
798   ValueType:=icvIdentifier;
799   Index:=aCompletion.Position;
800   IdentList:=CodeToolBoss.IdentifierList;
801 
802   IdentItem:=IdentList.FilteredItems[Index];
803   if IdentItem=nil then begin
804     ValueType := icvNone;
805     exit;
806   end;
807 
808   IdentItem.BeautifyIdentifier(IdentList);
809   CodeToolBoss.IdentItemCheckHasChilds(IdentItem);
810 
811   CanAddSemicolon:=CodeToolsOpts.IdentComplAddSemicolon and (AddChar<>';');
812   CanAddComma:=CodeToolsOpts.IdentComplAddSemicolon and (AddChar<>',');
813   IsReadOnly:=false;
814 
815   Result:=IdentItem.Identifier;
816 
817   //debugln(['GetIdentCompletionValue IdentItem.GetDesc=',NodeDescriptionAsString(IdentItem.GetDesc),' IdentList.ContextFlags=',dbgs(IdentList.ContextFlags),' IdentItem.Node=',IdentItem.Node<>nil]);
818 
819   case IdentItem.GetDesc of
820 
821     ctnProcedure:
822     begin
823       if (ilcfCanProcDeclaration in IdentList.ContextFlags)
824       and (IdentItem.Node<>nil) then begin
825         //DebugLn(['GetIdentCompletionValue icvCompleteProcDeclaration']);
826         ValueType:=icvCompleteProcDeclaration;
827       end else if IdentItem.IsProcNodeWithParams then
828         ValueType:=icvProcWithParams;
829     end;
830 
831     ctnProperty:
832       begin
833         if IdentItem.IsPropertyWithParams then
834           ValueType:=icvIndexedProp;
835         IsReadOnly:=IdentItem.IsPropertyReadOnly;
836       end;
837 
838     ctnUnit, ctnPackage, ctnLibrary, ctnUseUnitNamespace:
839       ValueType:=icvUnitName;
840   end;
841 
842   //Add the '&' character to prefixed identifiers
843   if (iliNeedsAmpersand in IdentItem.Flags) then
844     Result := '&' + Result;
845 
846   case ValueType of
847 
848     icvProcWithParams:
849       // add brackets for parameter lists
850       if (AddChar='')
851       and CodeToolsOpts.IdentComplAddParameterBrackets
852       and (ilcfStartInStatement in IdentList.ContextFlags)
853       and (not IdentList.StartUpAtomBehindIs('('))
854       and (not IdentList.StartUpAtomInFrontIs('@'))
855       and (IdentItem.ParamNameList<>'') then begin
856         Result+='()';
857         inc(CursorToLeft);
858         CursorAtEnd:=false;
859       end;
860 
861     icvIndexedProp:
862       // add brackets for parameter lists
863       if (AddChar='')
864       and CodeToolsOpts.IdentComplAddParameterBrackets
865       and (ilcfStartInStatement in IdentList.ContextFlags)
866       and (not IdentList.StartUpAtomBehindIs('[')) then begin
867         Result+='[]';
868         inc(CursorToLeft);
869         CursorAtEnd:=false;
870       end;
871 
872     icvCompleteProcDeclaration:
873       // create complete procedure declaration
874       if (AddChar='')
875       and (IdentList.StartAtomBehind.Flag in [cafEnd,cafWord,cafSemicolon])
876       and (ilcfEndOfLine in IdentList.ContextFlags)
877       and (IdentItem.Node<>nil) then begin
878         ProcHeadFlags:=[phpWithStart,phpWithVarModifiers,phpWithParameterNames,
879            phpWithDefaultValues,phpWithResultType,phpWithCallingSpecs,
880            phpWithProcModifiers];
881         if IdentList.StartUpAtomInFrontIs('PROCEDURE')
882         or IdentList.StartUpAtomInFrontIs('FUNCTION')
883         or IdentList.StartUpAtomInFrontIs('CONSTRUCTOR')
884         or IdentList.StartUpAtomInFrontIs('DESTRUCTOR')
885         then
886           Exclude(ProcHeadFlags,phpWithStart);
887         Result:=IdentItem.Tool.ExtractProcHead(IdentItem.Node,ProcHeadFlags);
888         ClassNode:=IdentItem.Tool.FindClassOrInterfaceNode(IdentItem.Node);
889         if (ClassNode<>nil)
890         and (ClassNode.Desc in [ctnClass,ctnObjCClass]) then begin
891           // replace virtual and dynamic with override
892           ProcModifierPos:=System.Pos('VIRTUAL;',UpperCaseStr(Result));
893           if ProcModifierPos<1 then
894             ProcModifierPos:=System.Pos('DYNAMIC;',UpperCaseStr(Result));
895           if ProcModifierPos>0 then
896             Result:=copy(Result,1,ProcModifierPos-1)+'override;'
897                     +copy(Result,ProcModifierPos+8,length(Result));
898         end;
899         // remove abstract
900         ProcModifierPos:=System.Pos('ABSTRACT;',UpperCaseStr(Result));
901         if ProcModifierPos>0 then
902           Result:=copy(Result,1,ProcModifierPos-1)
903                   +copy(Result,ProcModifierPos+9,length(Result));
904         StartContextPos:=CodeToolBoss.IdentifierList.StartContextPos;
905         Line:=StartContextPos.Code.GetLine(StartContextPos.Y-1,false);
906         Indent:=StartContextPos.X;
907         //debugln(['GetIdentCompletionValue ',Indent,' "',dbgstr(Line),'" ',GetLineIndent(Line,1),' empty=',InEmptyLine(Line,1),' ',DbgsCXY(StartContextPos)]);
908         if not InEmptyLine(Line,1) then
909           Indent:=GetLineIndent(Line,1);
910         Result:=TrimLeft(CodeToolBoss.SourceChangeCache
911           .BeautifyCodeOptions.BeautifyProc(Result,Indent,false));
912         //debugln(['GetIdentCompletionValue ',dbgstr(Result),' LineLen=',CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.LineLength]);
913         CanAddSemicolon:=false;
914       end;
915   end;
916 
917   if CursorAtEnd then ;
918 
919   // add assignment operator :=
920   //debugln(['GetIdentCompletionValue CursorToLeft=',CursorToLeft,' AddChar=',AddChar,' ilcfStartOfStatement=',ilcfStartOfStatement in IdentList.ContextFlags,' ilcfEndOfLine=',ilcfEndOfLine in IdentList.ContextFlags]);
921   if (CursorToLeft=0)
922   and (AddChar='')
923   and (ilcfStartOfStatement in IdentList.ContextFlags)
924   and ((ilcfEndOfLine in IdentList.ContextFlags) or IdentList.StartUpAtomBehindIs(';'))
925   and (not IdentItem.HasChilds)
926   and (not IdentItem.HasIndex)
927   and (not IsReadOnly)
928   and (not IdentList.StartUpAtomBehindIs(':='))
929   and (not IdentList.StartUpAtomBehindIs('('))
930   and (IdentItem.CanBeAssigned)
931   and CodeToolsOpts.IdentComplAddAssignOperator then begin
932     if (atIdentifier in CodeToolsOpts.DoInsertSpaceAfter)
933     or (atSymbol in CodeToolsOpts.DoInsertSpaceInFront) then
934       Result+=' ';
935     Result+=':=';
936     if (atSymbol in CodeToolsOpts.DoInsertSpaceAfter) then
937       Result+=' ';
938   end;
939 
940   // add last typed character (that ended the identifier completion and starts a new token)
941   if AddChar<>'' then
942     Result+=AddChar;
943 
944   if CanAddComma
945   and (ilcfNeedsEndComma in IdentList.ContextFlags) then
946   begin
947     Result+=',';
948   end;
949 
950   if CodeToolsOpts.IdentComplAddSemicolon and
951      (IdentItem.GetDesc in [ctnUseUnitNamespace,ctnUseUnitClearName]) and (AddChar<>'.') and
952      not IdentList.StartUpAtomBehindIs('.')//check if there is already a point
953   then
954     Result+='.';
955 
956   // add 'do'
957   if CodeToolsOpts.IdentComplAddDo and (AddChar='')
958   and (ilcfNeedsDo in IdentList.ContextFlags) then begin
959     s:=' '+CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('do');
960     Result+=s;
961     inc(CursorToLeft,length(s));
962   end;
963 
964   // add semicolon for statement ends
965   //debugln(['GetIdentCompletionValue CanAddSemicolon=',CanAddSemicolon,' ilcfNoEndSemicolon=',ilcfNoEndSemicolon in IdentList.ContextFlags,' ']);
966   if CanAddSemicolon
967   and (not (ilcfNoEndSemicolon in IdentList.ContextFlags))
968   then begin
969     if (ilcfNeedsEndSemicolon in IdentList.ContextFlags)
970     or ((ilcfStartInStatement in IdentList.ContextFlags)
971         and (IdentItem.GetDesc=ctnProcedure))
972     then begin
973       Result+=';';
974       if (CursorToLeft=0) and (IdentItem.GetDesc=ctnProcedure)
975       and (not IdentItem.IsFunction) then begin
976         // a procedure call without parameters
977         // => put cursor behind semicolon
978       end else begin
979         // keep cursor in front of semicolon
980         inc(CursorToLeft);
981       end;
982     end;
983   end;
984 
985   //DebugLn(['GetIdentCompletionValue END Result="',Result,'"']);
986 end;
987 
BreakLinesInTextnull988 function BreakLinesInText(const s: string; MaxLineLength: integer): string;
989 begin
990   Result:=BreakString(s,MaxLineLength,GetLineIndent(s,1));
991 end;
992 
993 procedure InitSynREEngine;
994 begin
995   if SynREEngine=nil then
996     SynREEngine:=TRegExpr.Create;
997 end;
998 
SynREMatchesnull999 function SynREMatches(const TheText, RegExpr, ModifierStr: string;
1000   StartPos: integer): boolean;
1001 begin
1002   InitSynREEngine;
1003   SynREEngine.ModifierStr:=ModifierStr;
1004   SynREEngine.Expression:=RegExpr;
1005   SynREEngine.InputString:=TheText;
1006   Result:=SynREEngine.ExecPos(StartPos);
1007 end;
1008 
SynREVarnull1009 function SynREVar(Index: Integer): string;
1010 begin
1011   if SynREEngine<>nil then
1012     Result:=SynREEngine.Match[Index]
1013   else
1014     Result:='';
1015 end;
1016 
1017 procedure SynREVarPos(Index: Integer; out MatchStart, MatchLength: integer);
1018 begin
1019   if SynREEngine<>nil then begin
1020     MatchStart:=SynREEngine.MatchPos[Index];
1021     MatchLength:=SynREEngine.MatchLen[Index];
1022   end else begin
1023     MatchStart:=-1;
1024     MatchLength:=-1;
1025   end;
1026 end;
1027 
SynREVarCountnull1028 function SynREVarCount: Integer;
1029 begin
1030   if SynREEngine<>nil then
1031     Result:=SynREEngine.SubExprMatchCount
1032   else
1033     Result:=0;
1034 end;
1035 
SynREReplacenull1036 function SynREReplace(const TheText, FindRegExpr, ReplaceRegExpr: string;
1037   UseSubstutition: boolean; const ModifierStr: string): string;
1038 begin
1039   InitSynREEngine;
1040   SynREEngine.ModifierStr:=ModifierStr;
1041   SynREEngine.Expression:=FindRegExpr;
1042   Result:=SynREEngine.Replace(TheText,ReplaceRegExpr,UseSubstutition);
1043 end;
1044 
1045 procedure SynRESplit(const TheText, SeparatorRegExpr: string; Pieces: TStrings;
1046   const ModifierStr: string);
1047 begin
1048   InitSynREEngine;
1049   SynREEngine.ModifierStr:=ModifierStr;
1050   SynREEngine.Expression:=SeparatorRegExpr;
1051   SynREEngine.Split(TheText,Pieces);
1052 end;
1053 
1054 { TLazIdentifierListItem }
1055 
1056 procedure TLazIdentifierListItem.BeautifyIdentifier(IdentList: TIdentifierList);
1057 begin
1058   if FBeautified then
1059     Exit;
1060 
1061   CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.WordExceptions.CheckExceptions(Identifier);
1062   FBeautified:=True;
1063 end;
1064 
1065 { TLazUnitNameSpaceIdentifierListItem }
1066 
1067 procedure TLazUnitNameSpaceIdentifierListItem.BeautifyIdentifier(
1068   IdentList: TIdentifierList);
1069 var
1070   CodeBuf: TCodeBuffer;
1071   LastPointPos: Integer;
1072   NewIdentifier: string;
1073   WordExc: TWordPolicyExceptions;
1074 begin
1075   if FBeautified then
1076     Exit;
1077 
1078   NewIdentifier:=Identifier;
1079   WordExc:=CodeToolBoss.SourceChangeCache.BeautifyCodeOptions.WordExceptions;
1080   if not WordExc.CheckExceptions(NewIdentifier) then
1081   begin
1082     CodeBuf:=CodeToolBoss.FindUnitSource(IdentList.StartContextPos.Code,FileUnitName,'');
1083     if CodeBuf=nil then Exit;
1084 
1085     NewIdentifier:=Copy(CodeToolBoss.GetSourceName(CodeBuf,true),
1086                         IdentifierStartInUnitName, Length(Identifier));
1087 
1088     LastPointPos := LastDelimiter('.', NewIdentifier);
1089     if LastPointPos > 0 then
1090       NewIdentifier := Copy(NewIdentifier, LastPointPos+1, length(NewIdentifier));
1091     if NewIdentifier='' then
1092       NewIdentifier:=Identifier;
1093   end;
1094   Identifier := NewIdentifier;
1095   FBeautified := True;
1096 end;
1097 
1098 { TLazTextConverterToolClasses }
1099 
GetTempFilenamenull1100 function TLazTextConverterToolClasses.GetTempFilename: string;
1101 var
1102   BaseDir: String;
1103 begin
1104   BaseDir:='';
1105   if LazarusIDE.ActiveProject<>nil then
1106     BaseDir:=ExtractFilePath(LazarusIDE.ActiveProject.ProjectInfoFile);
1107   if BaseDir='' then
1108     BaseDir:=LazarusIDE.GetTestBuildDirectory;
1109   if BaseDir='' then
1110     BaseDir:=GetCurrentDirUTF8;
1111   BaseDir:=CleanAndExpandDirectory(BaseDir);
1112   Result:=FileProcs.GetTempFilename(BaseDir,'convert_');
1113 end;
1114 
TLazTextConverterToolClasses.LoadFromFilenull1115 function TLazTextConverterToolClasses.LoadFromFile(
1116   Converter: TIDETextConverter; const AFilename: string; UpdateFromDisk,
1117   Revert: Boolean): Boolean;
1118 var
1119   TheFilename: String;
1120   CodeBuf: TCodeBuffer;
1121   TargetCodeBuffer: TCodeBuffer;
1122 begin
1123   TheFilename:=TrimAndExpandFilename(AFilename);
1124   if TheFilename='' then exit(false);
1125   CodeBuf:=CodeToolBoss.FindFile(TheFilename);
1126   if CodeBuf=nil then begin
1127     // it is not in cache
1128     // to save memory do not load it into the cache and use the default way
1129     //DebugLn(['TLazTextConverterToolClasses.LoadFromFile not in cache, using default ...']);
1130     Result:=Converter.LoadFromFile(AFilename,false,UpdateFromDisk,Revert);
1131   end else begin
1132     // use cache
1133     //DebugLn(['TLazTextConverterToolClasses.LoadFromFile using cache']);
1134     CodeBuf:=CodeToolBoss.LoadFile(TheFilename,UpdateFromDisk,Revert);
1135     if CodeBuf=nil then
1136       exit(false);
1137     Result:=true;
1138     //DebugLn(['TLazTextConverterToolClasses.LoadFromFile Converter.CurrentType=',ord(Converter.CurrentType)]);
1139     case Converter.CurrentType of
1140     tctSource:
1141       Converter.Source:=CodeBuf.Source;
1142     tctFile:
1143       Result:=SaveStringToFile(Converter.Filename,CodeBuf.Source,[])=mrOk;
1144     tctStrings:
1145       CodeBuf.AssignTo(Converter.Strings,true);
1146     tctCodeBuffer:
1147       begin
1148         if Converter.CodeBuffer=nil then
1149           Converter.CodeBuffer:=CodeBuf
1150         else begin
1151           TargetCodeBuffer:=(TObject(Converter.CodeBuffer) as TCodeBuffer);
1152           if TargetCodeBuffer<>CodeBuf then
1153             TargetCodeBuffer.Source:=CodeBuf.Source;
1154         end;
1155       end;
1156     end;
1157   end;
1158 end;
1159 
TLazTextConverterToolClasses.SaveCodeBufferToFilenull1160 function TLazTextConverterToolClasses.SaveCodeBufferToFile(
1161   Converter: TIDETextConverter; const AFilename: string): Boolean;
1162 begin
1163   Result:=(TObject(Converter.CodeBuffer) as TCodeBuffer).SaveToFile(AFilename);
1164 end;
1165 
GetCodeBufferSourcenull1166 function TLazTextConverterToolClasses.GetCodeBufferSource(
1167   Converter: TIDETextConverter; out Source: string): boolean;
1168 begin
1169   Result:=true;
1170   Source:=(TObject(Converter.CodeBuffer) as TCodeBuffer).Source;
1171 end;
1172 
CreateCodeBuffernull1173 function TLazTextConverterToolClasses.CreateCodeBuffer(
1174   Converter: TIDETextConverter; const Filename, NewSource: string; out
1175   CodeBuffer: Pointer): boolean;
1176 begin
1177   CodeBuffer:=CodeToolBoss.CreateFile(Filename);
1178   if CodeBuffer<>nil then begin
1179     TCodeBuffer(CodeBuffer).Source:=NewSource;
1180     Result:=true;
1181   end else
1182     Result:=false;
1183 end;
1184 
TLazTextConverterToolClasses.LoadCodeBufferFromFilenull1185 function TLazTextConverterToolClasses.LoadCodeBufferFromFile(
1186   Converter: TIDETextConverter; const Filename: string;
1187   UpdateFromDisk, Revert: Boolean; out CodeBuffer: Pointer): boolean;
1188 begin
1189   CodeBuffer:=CodeToolBoss.LoadFile(Filename,UpdateFromDisk,Revert);
1190   Result:=CodeBuffer<>nil;
1191 end;
1192 
1193 procedure TLazTextConverterToolClasses.AssignCodeToolBossError(
1194   Target: TCustomTextConverterTool);
1195 begin
1196   Target.ErrorMsg:=CodeToolBoss.ErrorMessage;
1197   Target.ErrorLine:=CodeToolBoss.ErrorLine;
1198   Target.ErrorColumn:=CodeToolBoss.ErrorColumn;
1199   Target.ErrorTopLine:=CodeToolBoss.ErrorTopLine;
1200   if CodeToolBoss.ErrorCode<>nil then
1201     Target.ErrorFilename:=CodeToolBoss.ErrorCode.Filename
1202   else
1203     Target.ErrorFilename:='';
1204 end;
1205 
SupportsTypenull1206 function TLazTextConverterToolClasses.SupportsType(aTextType: TTextConverterType
1207   ): boolean;
1208 begin
1209   Result:=true;
1210 end;
1211 
1212 initialization
1213   REException:=ERegExpr;
1214   REMatchesFunction:=@SynREMatches;
1215   REVarFunction:=@SynREVar;
1216   REVarPosProcedure:=@SynREVarPos;
1217   REVarCountFunction:=@SynREVarCount;
1218   REReplaceProcedure:=@SynREReplace;
1219   RESplitFunction:=@SynRESplit;
1220   CIdentifierListItem:=TLazIdentifierListItem;
1221   CUnitNameSpaceIdentifierListItem:=TLazUnitNameSpaceIdentifierListItem;
1222 
1223 finalization
1224   FreeAndNil(SynREEngine);
1225 
1226 end.
1227 
1228