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