← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to components/codetools/stdcodetools.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/codetools/stdcodetools.pas
53
53
  FindDeclarationTool, IdentCompletionTool, PascalReaderTool, PascalParserTool,
54
54
  CodeBeautifier, ExprEval, KeywordFuncLists, BasicCodeTools, LinkScanner,
55
55
  CodeCache, AVL_Tree, LFMTrees, SourceChanger,
56
 
  CustomCodeTool, CodeToolsStructs;
 
56
  CustomCodeTool, CodeToolsStructs, LazFileUtils;
57
57
 
58
58
type
59
59
  TUsesSection = (usMain, usImplementation);
131
131
    function FindMissingUnits(var MissingUnits: TStrings; FixCase: boolean;
132
132
                              SearchImplementation: boolean;
133
133
                              SourceChangeCache: TSourceChangeCache): boolean;
 
134
    function CommentUnitsInUsesSection(MissingUnits: TStrings;
 
135
      SourceChangeCache: TSourceChangeCache; UsesNode: TCodeTreeNode): boolean;
134
136
    function CommentUnitsInUsesSections(MissingUnits: TStrings;
135
137
                                SourceChangeCache: TSourceChangeCache): boolean;
136
138
    function FindUnusedUnits(Units: TStrings): boolean;
233
235
          SourceChangeCache: TSourceChangeCache;
234
236
          OnlyIfCursorBlockIndented: boolean;
235
237
          out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
236
 
      
 
238
 
237
239
    // compiler directives
238
240
    function GuessMisplacedIfdefEndif(const CursorPos: TCodeXYPosition;
239
241
          out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean;
275
277
          SourceChangeCache: TSourceChangeCache;
276
278
          SkipPointWords: boolean = false): boolean;
277
279
 
 
280
    // comments
 
281
    function CommentCode(const StartPos, EndPos: integer;
 
282
          SourceChangeCache: TSourceChangeCache; Apply: boolean): boolean;
 
283
 
278
284
    // expressions
279
285
    function GetStringConstBounds(const CursorPos: TCodeXYPosition;
280
286
          out StartPos, EndPos: TCodeXYPosition;
601
607
    'cthreads'
602
608
    );
603
609
var
604
 
  Options: TBeautifyCodeOptions;
 
610
  Beauty: TBeautifyCodeOptions;
605
611
 
606
612
  function SpecialUnitPriority(Identifier: PChar): integer;
607
613
  begin
643
649
      exit;
644
650
    end;
645
651
    Line:=Lines[Lines.Count-1];
646
 
    if (atIdentifier in Options.DoInsertSpaceAfter)
647
 
    or (atComma in Options.DoInsertSpaceInFront) then
 
652
    if (atIdentifier in Beauty.DoInsertSpaceAfter)
 
653
    or (atComma in Beauty.DoInsertSpaceInFront) then
648
654
      Line:=Line+' ';
649
655
    Line:=Line+',';
650
656
    l:=length(Line)+length(NewUses)+1; // +1 for the following , or ;
651
 
    if (atComma in Options.DoInsertSpaceAfter)
652
 
    or (atIdentifier in Options.DoInsertSpaceInFront) then
 
657
    if (atComma in Beauty.DoInsertSpaceAfter)
 
658
    or (atIdentifier in Beauty.DoInsertSpaceInFront) then
653
659
      inc(l);
654
660
    if Lines.Count=1 then
655
661
      inc(l,FirstIndent);
656
662
    //DebugLn(['AddUseUnit Lines.Count=',Lines.Count,' l=',l,' Line="',Line,'" NewUses=',NewUses,' FirstIndent=',FirstIndent]);
657
 
    if l<=Options.LineLength then begin
 
663
    if l<=Beauty.LineLength then begin
658
664
      // append to last line
659
 
      if (atComma in Options.DoInsertSpaceAfter)
660
 
      or (atIdentifier in Options.DoInsertSpaceInFront) then
 
665
      if (atComma in Beauty.DoInsertSpaceAfter)
 
666
      or (atIdentifier in Beauty.DoInsertSpaceInFront) then
661
667
        Line:=Line+' ';
662
668
      Line:=Line+NewUses;
663
669
      Lines[Lines.Count-1]:=Line;
664
670
    end else begin
665
671
      // add new line
666
672
      Lines[Lines.Count-1]:=Line;
667
 
      Line:=GetIndentStr(Indent)+NewUses;
 
673
      Line:=Beauty.GetIndentStr(Indent)+NewUses;
668
674
      Lines.Add(Line);
669
675
    end;
670
676
  end;
698
704
  or (not IsDottedIdentifier(NewUnitName))
699
705
  then exit;
700
706
  SourceChangeCache.MainScanner:=Scanner;
701
 
  Options:=SourceChangeCache.BeautifyCodeOptions;
 
707
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
702
708
 
703
709
  // find nice insert position
704
710
 
705
711
  Prio:=SpecialUnitPriority(PChar(NewUnitName));
706
 
  UsesInsertPolicy:=Options.UsesInsertPolicy;
 
712
  UsesInsertPolicy:=Beauty.UsesInsertPolicy;
707
713
  if AsLast then
708
714
    UsesInsertPolicy:=uipLast;
709
715
  InsertPosFound:=false;
812
818
  NewUsesTerm:=NewUnitName;
813
819
  if NewUnitInFile<>'' then
814
820
    NewUsesTerm:=NewUsesTerm+' '
815
 
      +Options.BeautifyKeyWord('in')
 
821
      +Beauty.BeautifyKeyWord('in')
816
822
      +' '''+NewUnitInFile+'''';
817
823
 
818
824
  NewComma:=',';
819
 
  if (atComma in Options.DoInsertSpaceInFront)
820
 
    or (atIdentifier in Options.DoInsertSpaceAfter)
 
825
  if (atComma in Beauty.DoInsertSpaceInFront)
 
826
    or (atIdentifier in Beauty.DoInsertSpaceAfter)
821
827
  then
822
828
    NewComma:=' '+NewComma;
823
 
  if (atComma in Options.DoInsertSpaceAfter)
824
 
    or (atIdentifier in Options.DoInsertSpaceInFront)
 
829
  if (atComma in Beauty.DoInsertSpaceAfter)
 
830
    or (atIdentifier in Beauty.DoInsertSpaceInFront)
825
831
  then
826
832
    NewComma:=NewComma+' ';
827
833
 
844
850
  // if not, rebuild the uses section
845
851
  GetLineStartEndAtPosition(Src,InsertPos,LineStart,LineEnd);
846
852
  InsertLen:=length(NewUsesTerm)+length(NewComma);
847
 
  //DebugLn(['TStandardCodeTool.AddUnitToUsesSection Line=',copy(Src,LineStart,InsertPos-LineStart),'<InsertPos>',copy(Src,InsertPos,LineEnd-InsertPos),' NewLen=',LineEnd-LineStart+InsertLen,' Max=',Options.LineLength,' Addition=',NewUsesTerm]);
848
 
  if (LineEnd-LineStart+InsertLen > Options.LineLength) then begin
 
853
  //DebugLn(['TStandardCodeTool.AddUnitToUsesSection Line=',copy(Src,LineStart,InsertPos-LineStart),'<InsertPos>',copy(Src,InsertPos,LineEnd-InsertPos),' NewLen=',LineEnd-LineStart+InsertLen,' Max=',Beauty.LineLength,' Addition=',NewUsesTerm]);
 
854
  if (LineEnd-LineStart+InsertLen > Beauty.LineLength) then begin
849
855
    // line too long => reformat block of used units
850
856
    // find start of block of used units
851
857
    Node:=InsertNode;
855
861
    InsertPos:=Node.StartPos;
856
862
    GetLineStartEndAtPosition(Src,InsertPos,LineStart,LineEnd);
857
863
    FirstIndent:=InsertPos-LineStart;
858
 
    Indent:=GetLineIndent(Src,InsertPos);
 
864
    Indent:=Beauty.GetLineIndent(Src,InsertPos);
859
865
    if PositionsInSameLine(Src,UsesNode.StartPos,InsertPos) then begin
860
866
      // for example: uses |unit1;
861
 
      inc(Indent,Options.Indent);
 
867
      inc(Indent,Beauty.Indent);
862
868
    end;
863
869
    // create new block of used units
864
870
    Lines:=TStringList.Create;
870
876
        InsertCode:=ExtractUsedUnitName(Node);
871
877
        if UpAtomIs('IN') then begin
872
878
          ReadNextAtom;
873
 
          InsertCode:=InsertCode+' '+Options.BeautifyKeyWord('in')+' '+GetAtom;
 
879
          InsertCode:=InsertCode+' '+Beauty.BeautifyKeyWord('in')+' '+GetAtom;
874
880
        end;
875
881
        AddUseUnit(Lines,FirstIndent,Indent,InsertCode);
876
882
        if (Node=InsertNode) and InsertBehind then
881
887
      InsertCode:='';
882
888
      for i:=0 to Lines.Count-1 do begin
883
889
        if i>0 then
884
 
          InsertCode:=InsertCode+Options.LineEnd;
 
890
          InsertCode:=InsertCode+Beauty.LineEnd;
885
891
        InsertCode:=InsertCode+Lines[i];
886
892
      end;
887
893
    finally
919
925
  UsesNode, OtherUsesNode, SectionNode: TCodeTreeNode;
920
926
  NewUsesTerm: string;
921
927
  InsertPos: integer;
922
 
  Junk     : TAtomPosition;
 
928
  Junk: TAtomPosition;
 
929
  Beauty: TBeautifyCodeOptions;
923
930
begin
924
931
  Result:=false;
925
932
  if not IsDottedIdentifier(NewUnitName) then exit;
938
945
    RaiseException('can not add a unit to the implementation, because only a unit has one');
939
946
  end;
940
947
  SourceChangeCache.MainScanner:=Scanner;
 
948
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
941
949
  SourceChangeCache.BeginUpdate;
942
950
  try
943
951
    UsesNode:=FindMainUsesSection;
984
992
          usMain: NewUsesTerm:='interface';
985
993
          usImplementation: NewUsesTerm:='implementation';
986
994
          end;
987
 
          NewUsesTerm:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord(NewUsesTerm)
988
 
                      +SourceChangeCache.BeautifyCodeOptions.LineEnd;
 
995
          NewUsesTerm:=Beauty.BeautifyKeyWord(NewUsesTerm)
 
996
                      +Beauty.LineEnd;
989
997
          if SectionNode.FirstChild<>nil then begin
990
998
            // unit not empty => add in front of first node
991
999
            InsertPos:=FindLineEndOrCodeInFrontOfPosition(SectionNode.FirstChild.StartPos,
1007
1015
          InsertPos:=FindLineEndOrCodeInFrontOfPosition(SectionNode.EndPos,true);
1008
1016
        end;
1009
1017
      end;
1010
 
      NewUsesTerm:=NewUsesTerm
1011
 
           +SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord('uses')
1012
 
           +' '+NewUnitName;
 
1018
      NewUsesTerm:=NewUsesTerm+Beauty.BeautifyKeyWord('uses')+' '+NewUnitName;
1013
1019
      if NewUnitInFile<>'' then
1014
1020
        NewUsesTerm:=NewUsesTerm+' in '''+NewUnitInFile+''';'
1015
1021
      else
1016
1022
        NewUsesTerm:=NewUsesTerm+';';
1017
1023
      if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
1018
1024
        NewUsesTerm) then exit;
1019
 
      if not SourceChangeCache.Apply then exit;
1020
1025
    end;
1021
1026
    Result:=true;
1022
1027
  finally
1023
1028
    if not Result then
1024
1029
      SourceChangeCache.Clear;
1025
 
    SourceChangeCache.EndUpdate;
 
1030
    if not SourceChangeCache.EndUpdate then
 
1031
      Result:=false;
1026
1032
  end;
1027
1033
end;
1028
1034
 
1100
1106
        if AtomIsChar(';') then begin
1101
1107
          // last unit in uses section -> delete whole uses section
1102
1108
          StartPos:=FindLineEndOrCodeInFrontOfPosition(UsesNode.StartPos,true,true);
1103
 
          if not SourceChangeCache.Replace(gtNone,gtNone,
1104
 
            StartPos,UsesNode.EndPos,'') then exit;
 
1109
          EndPos:=UsesNode.EndPos;
1105
1110
        end else begin
1106
1111
          // not last unit -> delete with comma behind
1107
1112
          EndPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos);
1108
1113
          if (EndPos>SrcLen) or (Src[EndPos] in [#10,#13]) then
1109
1114
            StartPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);// delete space in front or even the empty line
1110
 
          if not SourceChangeCache.Replace(gtNone,gtNone,
1111
 
            StartPos,EndPos,'') then exit;
1112
1115
        end;
1113
1116
      end else begin
1114
 
        // not first unit in uses section -> delete with comma in front
1115
 
        if not SourceChangeCache.Replace(gtNone,gtNone,
1116
 
          EndPos,CurPos.StartPos,'') then exit;
 
1117
        // not first unit in uses section
 
1118
        if AtomIsChar(';') then begin
 
1119
          // last unit -> delete with comma in front
 
1120
          StartPos:=EndPos;
 
1121
          EndPos:=CurPos.StartPos;
 
1122
        end else if PositionsInSameLine(Src,EndPos,StartPos) then begin
 
1123
          // not first unit in line -> delete with comma in front
 
1124
          StartPos:=EndPos;
 
1125
          EndPos:=CurPos.StartPos;
 
1126
        end else begin
 
1127
          // first unit in line -> delete with comma behind
 
1128
          EndPos:=FindLineEndOrCodeAfterPosition(CurPos.EndPos);
 
1129
          if (EndPos>SrcLen) or (Src[EndPos] in [#10,#13]) then
 
1130
            StartPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);// delete space in front or even the empty line
 
1131
        end;
1117
1132
      end;
 
1133
      if not SourceChangeCache.Replace(gtNone,gtNone,StartPos,EndPos,'') then
 
1134
        exit;
1118
1135
      if not SourceChangeCache.Apply then exit;
1119
1136
      Result:=true;
1120
1137
      exit;
1195
1212
      CurDir:=ExtractFilePath(TCodeBuffer(Scanner.MainCode).Filename);
1196
1213
      AFilename:=CurDir+AFilename;
1197
1214
    end;
1198
 
    CheckDirectoryCache;
1199
 
    if DirectoryCache=nil then exit;
1200
1215
    Result:=DirectoryCache.Pool.FindDiskFilename(AFilename,true);
1201
1216
    if Result='' then exit;
1202
1217
    if MakeRelative then
1389
1404
    // find unit file
1390
1405
    if AnUnitInFilename<>'' then begin
1391
1406
      // An 'in' unit => Delphi project file
1392
 
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
 
1407
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false,Node.StartPos);
1393
1408
      if (NewCode=nil) then begin
1394
1409
        // no source found
1395
1410
        MissingInUnits.Add(AnUnitName+' in '+AnUnitInFilename);
1399
1414
      end;
1400
1415
    end else if AnUnitName<>'' then begin
1401
1416
      // the units without 'in' are 'Forms' or units added by the user
1402
 
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
 
1417
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false,Node.StartPos);
1403
1418
      NormalUnits.AddObject(AnUnitName,NewCode);
1404
1419
    end;
1405
1420
    Node:=Node.NextBrother;
1432
1447
    AnUnitName:=ExtractUsedUnitName(Node,@AnUnitInFilename);
1433
1448
    if AnUnitName<>'' then begin
1434
1449
      // find unit file
1435
 
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false);
 
1450
      NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename,false,Node.StartPos);
1436
1451
      if (NewCode=nil) then begin
1437
1452
        // no source found
1438
1453
        UnitFilename:=AnUnitName;
1470
1485
function TStandardCodeTool.FindMissingUnits(var MissingUnits: TStrings;
1471
1486
  FixCase: boolean; SearchImplementation: boolean;
1472
1487
  SourceChangeCache: TSourceChangeCache): boolean;
1473
 
  
 
1488
const
 
1489
  FPCSrcSearchRequiresPPU = true;
 
1490
 
1474
1491
  function CheckUsesSection(UsesNode: TCodeTreeNode): boolean;
1475
1492
  var
1476
1493
    OldUnitName: String;
1484
1501
    Node: TCodeTreeNode;
1485
1502
  begin
1486
1503
    if UsesNode=nil then exit(true);
1487
 
    if not CheckDirectoryCache then exit(false);
1488
1504
 
1489
1505
    Node:=UsesNode.FirstChild;
1490
1506
    while Node<>nil do begin
1493
1509
      // find unit file
1494
1510
      NewUnitName:=OldUnitName;
1495
1511
      NewInFilename:=OldInFilename;
 
1512
      //debugln(['CheckUsesSection NewUnitName="',NewUnitName,'" NewInFilename="',NewInFilename,'"']);
1496
1513
      AFilename:=DirectoryCache.FindUnitSourceInCompletePath(
1497
 
                                                NewUnitName,NewInFilename,true);
 
1514
                        NewUnitName,NewInFilename,true,FPCSrcSearchRequiresPPU);
1498
1515
      s:=NewUnitName;
1499
1516
      if NewInFilename<>'' then
1500
1517
        s:=s+' in '''+NewInFilename+'''';
1507
1524
          FromPos:=Node.StartPos;
1508
1525
          ToPos:=Node.EndPos;
1509
1526
          SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,s);
1510
 
          DebugLn('CheckUsesSection fix case Unit Name(',OldUnitName,'->',NewUnitName,') InFile(',OldInFilename,'->',NewInFilename,')');
 
1527
          DebugLn('TStandardCodeTool.FindMissingUnits.CheckUsesSection fix case Unit Name(',OldUnitName,'->',NewUnitName,') InFile(',OldInFilename,'->',NewInFilename,')');
1511
1528
        end;
1512
1529
      end else begin
1513
1530
        // unit not found
1525
1542
  if FixCase then
1526
1543
    SourceChangeCache.MainScanner:=Scanner;
1527
1544
  try
1528
 
    if not CheckUsesSection(FindMainUsesSection) then exit;
 
1545
    if not CheckUsesSection(FindMainUsesSection(true)) then exit;
1529
1546
    if SearchImplementation
1530
1547
    and not CheckUsesSection(FindImplementationUsesSection) then exit;
1531
1548
  except
1538
1555
    Result:=true;
1539
1556
end;
1540
1557
 
1541
 
function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings;
1542
 
  SourceChangeCache: TSourceChangeCache): boolean;
1543
 
  
 
1558
function TStandardCodeTool.CommentUnitsInUsesSection(MissingUnits: TStrings;
 
1559
  SourceChangeCache: TSourceChangeCache; UsesNode: TCodeTreeNode): boolean;
 
1560
// Examples:
 
1561
// 1. uses {a,} b, c;    commenting one unit not at end
 
1562
// 2. uses a, {b,} c;    commenting one unit not at end
 
1563
// 3. uses {a, b,} c;    commenting several units not at end
 
1564
// 4. uses a{, b, c} ;   commenting units at end
 
1565
// 5. {uses a, b, c;}    commenting all units
 
1566
// 6. uses {a,} b{, c};  commenting several units
 
1567
 
1544
1568
  procedure Comment(StartPos, EndPos: integer);
1545
1569
  begin
1546
1570
    //debugln(['Comment ',dbgstr(copy(Src,StartPos,EndPos-StartPos))]);
1547
1571
    CommentCode(StartPos,EndPos,SourceChangeCache,false);
1548
1572
  end;
1549
1573
 
1550
 
  function CommentUnitsInUsesSection(UsesNode: TCodeTreeNode): boolean;
1551
 
  // Examples:
1552
 
  // 1. uses {a,} b, c;    commenting one unit not at end
1553
 
  // 2. uses a, {b,} c;    commenting one unit not at end
1554
 
  // 3. uses {a, b,} c;    commenting several units not at end
1555
 
  // 4. uses a{, b, c} ;   commenting units at end
1556
 
  // 5. {uses a, b, c;}    commenting all units
1557
 
  // 6. uses {a,} b{, c};  commenting several units
1558
 
  var
1559
 
    i: Integer;
1560
 
    CurUnitName: String;
1561
 
    CommentCurUnit: Boolean;
1562
 
    FirstCommentUnitStart: Integer;
1563
 
    LastCommaAfterCommentUnitsStart: Integer;
1564
 
    LastNormalUnitEnd: Integer;
1565
 
    LastCommentUnitEnd: Integer;
1566
 
    Node: TCodeTreeNode;
1567
 
  begin
1568
 
    Result:=true;
1569
 
    if UsesNode=nil then exit;
1570
 
    FirstCommentUnitStart:=-1;
1571
 
    LastCommaAfterCommentUnitsStart:=-1;
1572
 
    LastNormalUnitEnd:=-1;
1573
 
    LastCommentUnitEnd:=-1;
1574
 
    Node:=UsesNode.FirstChild;
1575
 
    while Node<>nil do begin
1576
 
      // check if unit should be commented
1577
 
      CurUnitName:=ExtractUsedUnitName(Node);
1578
 
      // Note: CurPos is now on atom behind used unit, i.e. comma or semicolon
1579
 
      i:=MissingUnits.Count-1;
1580
 
      while (i>=0)
1581
 
      and (CompareIdentifiers(PChar(Pointer(MissingUnits[i])),
1582
 
                              PChar(Pointer(CurUnitName)))<>0) do
1583
 
        dec(i);
1584
 
      CommentCurUnit:=i>=0;
1585
 
      //debugln('CommentUnitsInUsesSection CurUnitName="',CurUnitName,'" CommentCurUnit=',dbgs(CommentCurUnit));
1586
 
      
 
1574
var
 
1575
  i: Integer;
 
1576
  CurUnitName: String;
 
1577
  CommentCurUnit: Boolean;
 
1578
  FirstCommentUnitStart: Integer;
 
1579
  LastCommaAfterCommentUnitsStart: Integer;
 
1580
  LastNormalUnitEnd: Integer;
 
1581
  LastCommentUnitEnd: Integer;
 
1582
  Node: TCodeTreeNode;
 
1583
begin
 
1584
  Result:=true;
 
1585
  if UsesNode=nil then exit;
 
1586
  FirstCommentUnitStart:=-1;
 
1587
  LastCommaAfterCommentUnitsStart:=-1;
 
1588
  LastNormalUnitEnd:=-1;
 
1589
  LastCommentUnitEnd:=-1;
 
1590
  Node:=UsesNode.FirstChild;
 
1591
  while Node<>nil do begin
 
1592
    // check if unit should be commented
 
1593
    CurUnitName:=ExtractUsedUnitName(Node);
 
1594
    // Note: CurPos is now on atom behind used unit, i.e. comma or semicolon
 
1595
    i:=MissingUnits.Count-1;
 
1596
    while (i>=0)
 
1597
    and (CompareIdentifiers(PChar(Pointer(MissingUnits[i])),
 
1598
                            PChar(Pointer(CurUnitName)))<>0) do
 
1599
      dec(i);
 
1600
    CommentCurUnit:=i>=0;
 
1601
    //debugln('CommentUnitsInUsesSection CurUnitName="',CurUnitName,'" CommentCurUnit=',dbgs(CommentCurUnit));
 
1602
 
 
1603
    if CommentCurUnit then begin
 
1604
      // unit should be commented
 
1605
      if FirstCommentUnitStart<1 then FirstCommentUnitStart:=Node.StartPos;
 
1606
      LastCommentUnitEnd:=Node.EndPos;
 
1607
    end else begin
 
1608
      // unit should be kept
 
1609
      LastNormalUnitEnd:=Node.EndPos;
 
1610
      if FirstCommentUnitStart>=1 then begin
 
1611
        // there are some units to be commented
 
1612
        // See examples: 1., 2., 3. and 6.
 
1613
        Comment(FirstCommentUnitStart,LastCommaAfterCommentUnitsStart);
 
1614
        FirstCommentUnitStart:=-1;
 
1615
        LastCommentUnitEnd:=-1;
 
1616
        LastCommaAfterCommentUnitsStart:=-1;
 
1617
      end;
 
1618
    end;
 
1619
 
 
1620
    if CommentCurUnit then
 
1621
      LastCommaAfterCommentUnitsStart:=CurPos.EndPos;
 
1622
 
 
1623
    if CurPos.Flag<>cafComma then begin
1587
1624
      if CommentCurUnit then begin
1588
 
        // unit should be commented
1589
 
        if FirstCommentUnitStart<1 then FirstCommentUnitStart:=Node.StartPos;
1590
 
        LastCommentUnitEnd:=Node.EndPos;
1591
 
      end else begin
1592
 
        // unit should be kept
1593
 
        LastNormalUnitEnd:=Node.EndPos;
1594
 
        if FirstCommentUnitStart>=1 then begin
1595
 
          // there are some units to be commented
1596
 
          // See examples: 1., 2., 3. and 6.
1597
 
          Comment(FirstCommentUnitStart,LastCommaAfterCommentUnitsStart);
1598
 
          FirstCommentUnitStart:=-1;
1599
 
          LastCommentUnitEnd:=-1;
1600
 
          LastCommaAfterCommentUnitsStart:=-1;
1601
 
        end;
1602
 
      end;
1603
 
      
1604
 
      if CommentCurUnit then
1605
 
        LastCommaAfterCommentUnitsStart:=CurPos.EndPos;
1606
 
        
1607
 
      if CurPos.Flag<>cafComma then begin
1608
 
        if CommentCurUnit then begin
1609
 
          // last unit must be commented
1610
 
          if LastNormalUnitEnd>=1 then begin
1611
 
            // comment last unit and keep some units in front
1612
 
            // See example: 4.
1613
 
            Comment(LastNormalUnitEnd,LastCommentUnitEnd);
1614
 
          end else begin
1615
 
            // all units should be commented
1616
 
            // See example: 5.
1617
 
            Comment(UsesNode.StartPos,CurPos.EndPos);
1618
 
          end;
1619
 
        end;
1620
 
        break;
1621
 
      end;
1622
 
      
1623
 
      Node:=Node.NextBrother;
 
1625
        // last unit must be commented
 
1626
        if LastNormalUnitEnd>=1 then begin
 
1627
          // comment last unit and keep some units in front
 
1628
          // See example: 4.
 
1629
          Comment(LastNormalUnitEnd,LastCommentUnitEnd);
 
1630
        end else begin
 
1631
          // all units should be commented
 
1632
          // See example: 5.
 
1633
          Comment(UsesNode.StartPos,CurPos.EndPos);
 
1634
        end;
 
1635
      end;
 
1636
      break;
1624
1637
    end;
 
1638
 
 
1639
    Node:=Node.NextBrother;
1625
1640
  end;
1626
 
  
 
1641
end;
 
1642
 
 
1643
function TStandardCodeTool.CommentUnitsInUsesSections(MissingUnits: TStrings;
 
1644
  SourceChangeCache: TSourceChangeCache): boolean;
1627
1645
begin
 
1646
  if (MissingUnits=nil) or (MissingUnits.Count=0) then
 
1647
    exit(true);
1628
1648
  Result:=false;
1629
 
  if (MissingUnits=nil) or (MissingUnits.Count=0) then begin
1630
 
    Result:=true;
1631
 
    exit;
1632
 
  end;
1633
 
  BuildTree(lsrImplementationUsesSectionEnd);
 
1649
  BuildTree(lsrInitializationStart);
1634
1650
  SourceChangeCache.MainScanner:=Scanner;
1635
 
  if not CommentUnitsInUsesSection(FindMainUsesSection) then exit;
1636
 
  if not CommentUnitsInUsesSection(FindImplementationUsesSection) then exit;
 
1651
  if not CommentUnitsInUsesSection(MissingUnits, SourceChangeCache, FindMainUsesSection) then exit;
 
1652
  if not CommentUnitsInUsesSection(MissingUnits, SourceChangeCache, FindImplementationUsesSection) then exit;
1637
1653
  if not SourceChangeCache.Apply then exit;
1638
1654
  Result:=true;
1639
1655
end;
2096
2112
  ObjectsMustExist: boolean): boolean;
2097
2113
var
2098
2114
  RootContext: TFindContext;
2099
 
  
 
2115
 
2100
2116
  function CheckLFMObjectValues(LFMObject: TLFMObjectNode;
2101
2117
    const ClassContext: TFindContext; ContextIsDefault: boolean): boolean; forward;
2102
2118
 
2178
2194
    out IdentContext: TFindContext): boolean;
2179
2195
  var
2180
2196
    Params: TFindDeclarationParams;
2181
 
    IsPublished: Boolean;
 
2197
    IsPublished, IsMissingInCode: Boolean;
2182
2198
    CurContext: TFindContext;
2183
2199
  begin
2184
2200
    Result:=false;
2249
2265
      Params.Free;
2250
2266
    end;
2251
2267
 
 
2268
    IsMissingInCode := False;
2252
2269
    if (IdentContext.Node<>nil) and IsPublished then begin
2253
2270
      Result:=true;
2254
2271
    end else begin
2255
 
      // no proper node found
2256
 
      // -> search in DefineProperties
 
2272
      // no proper node found -> search in DefineProperties
2257
2273
      if SearchInDefinePropertiesToo then begin
2258
 
        //debugln('FindLFMIdentifier A SearchAlsoInDefineProperties=',dbgs(SearchInDefinePropertiesToo),' Identifier=',IdentName);
2259
 
        if FindNonPublishedDefineProperty(LFMNode,DefaultErrorPosition,
2260
 
          IdentName,ClassContext)
 
2274
        if FindNonPublishedDefineProperty(LFMNode,DefaultErrorPosition,IdentName,ClassContext)
2261
2275
        then begin
2262
2276
          //debugln(['FindLFMIdentifier "',IdentName,'" is defined via DefineProperties']);
2263
2277
          Result:=true;
2264
2278
        end;
2265
 
      end;
 
2279
      end
 
2280
      else
 
2281
        IsMissingInCode := True;
2266
2282
    end;
2267
2283
    if (not Result) and ErrorOnNotFound then begin
2268
2284
      if (IdentContext.Node<>nil) and (not IsPublished) then begin
2270
2286
                         'identifier '+IdentName+' is not published in class '
2271
2287
                         +'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false,true)+'"',
2272
2288
                         DefaultErrorPosition);
2273
 
      end else begin
 
2289
      end
 
2290
      else if IsMissingInCode then begin
 
2291
        LFMTree.AddError(lfmeIdentifierMissingInCode,LFMNode,
 
2292
                         'identifier '+IdentName+' not found in pascal code '
 
2293
                         +'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false,true)+'"',
 
2294
                         DefaultErrorPosition);
 
2295
      end
 
2296
      else begin
2274
2297
        LFMTree.AddError(lfmeIdentifierNotFound,LFMNode,
2275
2298
                         'identifier '+IdentName+' not found in class '
2276
2299
                         +'"'+ClassContext.Tool.ExtractClassName(ClassContext.Node,false,true)+'"',
2278
2301
      end;
2279
2302
    end;
2280
2303
  end;
2281
 
  
 
2304
 
2282
2305
  function FindClassNodeForLFMObject(LFMNode: TLFMTreeNode;
2283
2306
    DefaultErrorPosition: integer;
2284
2307
    StartTool: TFindDeclarationTool; DefinitionNode: TCodeTreeNode): TFindContext;
2353
2376
    if Context.Tool.CleanPosToCaret(Context.Node.StartPos,Caret) then
2354
2377
      Result:=Result+'('+IntToStr(Caret.Y)+','+IntToStr(Caret.X)+')';
2355
2378
  end;
2356
 
  
 
2379
 
2357
2380
  function FindClassContext(const ClassName: string): TFindContext;
2358
2381
  var
2359
2382
    Params: TFindDeclarationParams;
2393
2416
  end;
2394
2417
 
2395
2418
  procedure CheckLFMChildObject(LFMObject: TLFMObjectNode;
2396
 
    const ParentContext: TFindContext;
2397
 
    SearchAlsoInDefineProperties, ContextIsDefault: boolean);
 
2419
    const ParentContext: TFindContext; ContextIsDefault: boolean);
2398
2420
  var
2399
2421
    LFMObjectName: String;
2400
2422
    ChildContext: TFindContext;
2404
2426
    IdentifierFound: Boolean;
2405
2427
  begin
2406
2428
    // find variable for object
2407
 
    
 
2429
 
2408
2430
    // find identifier in Lookup Root
2409
2431
    LFMObjectName:=LFMObject.Name;
2410
2432
    //DebugLn('CheckChildObject A LFMObjectName="',LFMObjectName,'"');
2416
2438
 
2417
2439
    ChildContext:=CleanFindContext;
2418
2440
    IdentifierFound:=(not ContextIsDefault) and
2419
 
      FindLFMIdentifier(LFMObject,LFMObject.NamePosition,
2420
 
      LFMObjectName,RootContext,SearchAlsoInDefineProperties,ObjectsMustExist,
2421
 
      ChildContext);
 
2441
      FindLFMIdentifier(LFMObject,LFMObject.NamePosition,LFMObjectName,RootContext,
 
2442
          false,ObjectsMustExist,ChildContext);
2422
2443
 
2423
2444
    //debugln(['CheckLFMChildObject LFMObjectName="',LFMObjectName,'" IdentifierFound=',IdentifierFound,' ObjectsMustExist=',ObjectsMustExist,' ',FindContextToString(ChildContext)]);
2424
2445
    if IdentifierFound and (ObjectsMustExist or (ChildContext.Node<>nil)) then
2432
2453
      // check if identifier is a variable or property
2433
2454
      VariableTypeName:='';
2434
2455
      if (ChildContext.Node.Desc=ctnVarDefinition) then begin
2435
 
        DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(
2436
 
                                                             ChildContext.Node);
 
2456
        DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(ChildContext.Node);
2437
2457
        if DefinitionNode<>nil then begin
2438
 
          VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
2439
 
                                                             ChildContext.Node);
 
2458
          VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(ChildContext.Node);
2440
2459
        end;
2441
2460
      end else if (ChildContext.Node.Desc=ctnProperty) then begin
2442
2461
        DefinitionNode:=ChildContext.Node;
2443
 
        VariableTypeName:=
2444
 
               ChildContext.Tool.ExtractPropType(ChildContext.Node,false,false);
 
2462
        VariableTypeName:=ChildContext.Tool.ExtractPropType(ChildContext.Node,false,false);
2445
2463
      end;
2446
2464
      if DefinitionNode=nil then begin
2447
2465
        LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
2450
2468
                         LFMObject.NamePosition);
2451
2469
        exit;
2452
2470
      end;
2453
 
      
 
2471
 
2454
2472
      // check if variable/property has a compatible type
2455
2473
      if (VariableTypeName<>'') then begin
2456
2474
        if (LFMObject.TypeName<>'')
2464
2482
                         LFMObject.NamePosition);
2465
2483
          exit;
2466
2484
        end;
2467
 
        
 
2485
 
2468
2486
        // ToDo: check if variable/property type exists
2469
 
        
 
2487
 
2470
2488
      end;
2471
2489
 
2472
2490
 
2481
2499
      if ClassContext.Node=nil then begin
2482
2500
        // object type not found
2483
2501
        LFMTree.AddError(lfmeIdentifierNotFound,LFMObject,
2484
 
                         'type '+LFMObject.TypeName+' not found',
2485
 
                         LFMObject.TypeNamePosition);
 
2502
            'type '+LFMObject.TypeName+' not found',LFMObject.TypeNamePosition);
2486
2503
      end;
2487
2504
    end;
2488
2505
    // check child LFM nodes
2491
2508
    else
2492
2509
      CheckLFMObjectValues(LFMObject,ParentContext,true);
2493
2510
  end;
2494
 
  
 
2511
 
2495
2512
  function FindClassNodeForPropertyType(LFMProperty: TLFMPropertyNode;
2496
 
    DefaultErrorPosition: integer; const PropertyContext: TFindContext
2497
 
    ): TFindContext;
 
2513
    DefaultErrorPosition: integer; const PropertyContext: TFindContext): TFindContext;
2498
2514
  var
2499
2515
    Params: TFindDeclarationParams;
2500
2516
  begin
2546
2562
                       'property without name',LFMProperty.StartPos);
2547
2563
      exit;
2548
2564
    end;
2549
 
    
 
2565
 
2550
2566
    // find every part of the property name
2551
2567
    SearchContext:=ParentContext;
2552
2568
    for i:=0 to LFMProperty.NameParts.Count-1 do begin
2584
2600
    while CurLFMNode<>nil do begin
2585
2601
      //DebugLn('TStandardCodeTool.CheckLFM.CheckLFMObjectValues B ',CurLFMNode.ClassName);
2586
2602
      case CurLFMNode.TheType of
2587
 
      
2588
 
      lfmnObject:
2589
 
        CheckLFMChildObject(TLFMObjectNode(CurLFMNode),ClassContext,false,
2590
 
                            ContextIsDefault);
2591
 
 
2592
 
      lfmnProperty:
2593
 
        if not ContextIsDefault then
2594
 
          CheckLFMProperty(TLFMPropertyNode(CurLFMNode),ClassContext);
2595
 
 
 
2603
        lfmnObject:
 
2604
          CheckLFMChildObject(TLFMObjectNode(CurLFMNode),ClassContext,ContextIsDefault);
 
2605
        lfmnProperty:
 
2606
          if not ContextIsDefault then
 
2607
            CheckLFMProperty(TLFMPropertyNode(CurLFMNode),ClassContext);
2596
2608
      end;
2597
2609
      CurLFMNode:=CurLFMNode.NextSibling;
2598
2610
    end;
2599
2611
    Result:=true;
2600
2612
  end;
2601
 
  
 
2613
 
2602
2614
  function CheckLFMRoot(RootLFMNode: TLFMTreeNode): boolean;
2603
2615
  var
2604
2616
    LookupRootLFMNode: TLFMObjectNode;
2606
2618
    RootClassNode: TCodeTreeNode;
2607
2619
  begin
2608
2620
    Result:=false;
2609
 
    
 
2621
 
2610
2622
    //DebugLn('TStandardCodeTool.CheckLFM.CheckLFMRoot checking root ...');
2611
2623
    // get root object node
2612
2624
    if (RootLFMNode=nil) or (not (RootLFMNode is TLFMObjectNode)) then begin
2614
2626
      exit;
2615
2627
    end;
2616
2628
    LookupRootLFMNode:=TLFMObjectNode(RootLFMNode);
2617
 
    
 
2629
 
2618
2630
    // get type name of root object
2619
2631
    LookupRootTypeName:=LookupRootLFMNode.TypeName;
2620
2632
    if LookupRootTypeName='' then begin
2621
2633
      LFMTree.AddError(lfmeMissingRoot,nil,'missing type of root object',1);
2622
2634
      exit;
2623
2635
    end;
2624
 
    
 
2636
 
2625
2637
    // find root type
2626
2638
    if RootMustBeClassInIntf then begin
2627
2639
      RootClassNode:=FindClassNodeInInterface(LookupRootTypeName,true,false,false);
2645
2657
    end;
2646
2658
    Result:=CheckLFMObjectValues(LookupRootLFMNode,RootContext,false);
2647
2659
  end;
2648
 
  
 
2660
 
2649
2661
var
2650
2662
  CurRootLFMNode: TLFMTreeNode;
2651
2663
begin
2721
2733
var MainBeginNode: TCodeTreeNode;
2722
2734
  OldPosition: TAtomPosition;
2723
2735
  FromPos, ToPos, Indent: integer;
 
2736
  Beauty: TBeautifyCodeOptions;
2724
2737
begin
2725
2738
  Result:=false;
2726
2739
  if (AClassName='') or (length(AClassName)>255) or (AVarName='')
2728
2741
  BuildTree(lsrEnd);
2729
2742
  MainBeginNode:=FindMainBeginEndNode;
2730
2743
  if MainBeginNode=nil then exit;
 
2744
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
2731
2745
  FromPos:=-1;
2732
2746
  if FindCreateFormStatement(MainBeginNode.StartPos,AClassName,
2733
2747
    AVarName,OldPosition)=-1
2745
2759
    until (CurPos.StartPos>SrcLen);
2746
2760
    if FromPos<1 then exit;
2747
2761
    SourceChangeCache.MainScanner:=Scanner;
2748
 
    Indent:=GetLineIndent(Src,FromPos);
 
2762
    Indent:=Beauty.GetLineIndent(Src,FromPos);
2749
2763
    FromPos:=FindLineEndOrCodeInFrontOfPosition(FromPos);
2750
2764
    SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,FromPos,
2751
 
       SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
 
2765
       Beauty.BeautifyStatement(
2752
2766
         'Application.CreateForm('+AClassName+','+AVarName+');',Indent));
2753
2767
  end else begin
2754
2768
    // it exists -> replace it
2756
2770
    ToPos:=FindLineEndOrCodeAfterPosition(OldPosition.EndPos);
2757
2771
    SourceChangeCache.MainScanner:=Scanner;
2758
2772
    SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,ToPos,
2759
 
       SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
 
2773
       Beauty.BeautifyStatement(
2760
2774
         'Application.CreateForm('+AClassName+','+AVarName+');',
2761
 
         SourceChangeCache.BeautifyCodeOptions.Indent));
 
2775
         Beauty.Indent));
2762
2776
  end;
2763
2777
  Result:=SourceChangeCache.Apply;
2764
2778
end;
2785
2799
var MainBeginNode: TCodeTreeNode;
2786
2800
  OldPosition: TAtomPosition;
2787
2801
  FromPos, ToPos: integer;
 
2802
  Beauty: TBeautifyCodeOptions;
2788
2803
begin
2789
2804
  Result:=false;
2790
2805
  if (OldClassName='') or (length(OldClassName)>255)
2793
2808
  or (NewVarName='') or (length(NewVarName)>255)
2794
2809
  then exit;
2795
2810
  BuildTree(lsrEnd);
 
2811
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
2796
2812
  MainBeginNode:=FindMainBeginEndNode;
2797
2813
  if MainBeginNode=nil then exit;
2798
2814
  FromPos:=-1;
2810
2826
    ToPos:=FindLineEndOrCodeAfterPosition(OldPosition.EndPos);
2811
2827
    SourceChangeCache.MainScanner:=Scanner;
2812
2828
    SourceChangeCache.Replace(gtNewLine,gtNewLine,FromPos,ToPos,
2813
 
       SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
 
2829
       Beauty.BeautifyStatement(
2814
2830
         'Application.CreateForm('+NewClassName+','+NewVarName+');',
2815
 
         SourceChangeCache.BeautifyCodeOptions.Indent));
 
2831
         Beauty.Indent));
2816
2832
    Result:=SourceChangeCache.Apply;
2817
2833
  end;
2818
2834
end;
2858
2874
  MainBeginNode: TCodeTreeNode;
2859
2875
  AClassName, AVarName: string;
2860
2876
  LastEndPos: Integer;
 
2877
  Beauty: TBeautifyCodeOptions;
2861
2878
begin
2862
2879
  Result:= false;
2863
2880
  if (List = nil) or (SourceChangeCache = nil) then exit;
2865
2882
 
2866
2883
  { first delete all CreateForm Statements }
2867
2884
  SourceChangeCache.MainScanner:= Scanner;
 
2885
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
2868
2886
  MainBeginNode:=FindMainBeginEndNode;
2869
2887
  if MainBeginNode = nil then exit;
2870
2888
  Position:=MainBeginNode.StartPos;
2918
2936
      AVarName:= List[i];  
2919
2937
      AClassName:= 'T' + AVarName;
2920
2938
    end;  
2921
 
    Indent:= GetLineIndent(Src, InsertPos);
 
2939
    Indent:=Beauty.GetLineIndent(Src, InsertPos);
2922
2940
 
2923
2941
    SourceChangeCache.Replace(gtNewLine, gtNewLine, InsertPos, InsertPos,
2924
2942
      SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
2989
3007
  NewStatement: String;
2990
3008
  Indent: Integer;
2991
3009
  MainBeginNode: TCodeTreeNode;
 
3010
  Beauty: TBeautifyCodeOptions;
2992
3011
begin
2993
3012
  Result:=false;
2994
3013
  // search old Application.Title:= statement
 
3014
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
2995
3015
  OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
2996
3016
  if StringConstStartPos=0 then ;
2997
3017
  if OldExists then begin
2998
3018
    // replace old statement
2999
3019
    Indent:=0;
3000
 
    Indent:=GetLineIndent(Src,StartPos)
 
3020
    Indent:=Beauty.GetLineIndent(Src,StartPos)
3001
3021
  end else begin
3002
3022
    // insert as first line in program begin..end block
3003
3023
    MainBeginNode:=FindMainBeginEndNode;
3006
3026
    ReadNextAtom;
3007
3027
    StartPos:=CurPos.EndPos;
3008
3028
    EndPos:=StartPos;
3009
 
    Indent:=GetLineIndent(Src,StartPos)
3010
 
            +SourceChangeCache.BeautifyCodeOptions.Indent;
 
3029
    Indent:=Beauty.GetLineIndent(Src,StartPos)+Beauty.Indent;
3011
3030
  end;
3012
3031
  // create statement
3013
3032
  NewStatement:='Application.Title:='+StringToPascalConst(NewTitle)+';';
3014
 
  NewStatement:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
3015
 
    NewStatement,Indent);
 
3033
  NewStatement:=Beauty.BeautifyStatement(NewStatement,Indent);
3016
3034
  SourceChangeCache.MainScanner:=Scanner;
3017
3035
  if not SourceChangeCache.Replace(gtNewLine,gtNewLine,StartPos,EndPos,
3018
3036
                                   NewStatement)
3258
3276
  end;
3259
3277
end;
3260
3278
 
 
3279
function TStandardCodeTool.CommentCode(const StartPos, EndPos: integer;
 
3280
  SourceChangeCache: TSourceChangeCache; Apply: boolean): boolean;
 
3281
var
 
3282
  i: LongInt;
 
3283
  CurStartPos: LongInt;
 
3284
  CommentNeeded: Boolean;
 
3285
  CurEndPos: LongInt;
 
3286
begin
 
3287
  if StartPos>=EndPos then
 
3288
    RaiseException('TStandardCodeTool CommentCode');
 
3289
 
 
3290
  Result:=false;
 
3291
  // comment with curly brackets {}
 
3292
  i:=StartPos;
 
3293
  CurStartPos:=i;
 
3294
  CurEndPos:=CurStartPos;
 
3295
  CommentNeeded:=false;
 
3296
  repeat
 
3297
    //debugln(['TPascalReaderTool.CommentCode ',dbgstr(Src[i]),' Needed=',CommentNeeded,' ',dbgstr(copy(Src,CurStartPos,CurEndPos-CurStartPos))]);
 
3298
    if (Src[i]='{') or (i>=EndPos) then begin
 
3299
      // the area contains a comment -> comment in front
 
3300
      if CommentNeeded then begin
 
3301
        if not SourceChangeCache.Replace(gtNone,gtNone,
 
3302
          CurStartPos,CurStartPos,'{') then exit;
 
3303
        if not SourceChangeCache.Replace(gtNone,gtNone,
 
3304
          CurEndPos,CurEndPos,'}') then exit;
 
3305
        //DebugLn('Comment "',copy(Src,CurStartPos,i-CurStartPos),'"');
 
3306
        CommentNeeded:=false;
 
3307
      end;
 
3308
      if i>=EndPos then break;
 
3309
      // skip comment
 
3310
      i:=FindCommentEnd(Src,i,Scanner.NestedComments)-1;
 
3311
    end else if not IsSpaceChar[Src[i]] then begin
 
3312
      if not CommentNeeded then begin
 
3313
        CurStartPos:=i;
 
3314
        CommentNeeded:=true;
 
3315
      end;
 
3316
      CurEndPos:=i+1;
 
3317
    end;
 
3318
    inc(i);
 
3319
  until false;
 
3320
  if Apply then
 
3321
    Result:=SourceChangeCache.Apply
 
3322
  else
 
3323
    Result:=true;
 
3324
end;
 
3325
 
3261
3326
function TStandardCodeTool.GetStringConstBounds(
3262
3327
  const CursorPos: TCodeXYPosition;
3263
3328
  out StartPos, EndPos: TCodeXYPosition; ResolveComments: boolean): boolean;
3850
3915
 
3851
3916
function TStandardCodeTool.ConvertDelphiToLazarusSource(AddLRSCode: boolean;
3852
3917
  SourceChangeCache: TSourceChangeCache): boolean;
 
3918
var
 
3919
  Beauty: TBeautifyCodeOptions;
3853
3920
 
3854
3921
  function AddModeDelphiDirective: boolean;
3855
3922
  var
3963
4030
      end;
3964
4031
      if Tree.Root.Desc=ctnUnit then begin
3965
4032
        InitializationNode:=FindInitializationNode;
3966
 
        NewCode:=GetIndentStr(SourceChangeCache.BeautifyCodeOptions.Indent)
 
4033
        NewCode:=Beauty.GetIndentStr(Beauty.Indent)
3967
4034
                 +'{$i '+LRSFilename+'}';
3968
4035
        if InitializationNode=nil then begin
3969
4036
          // add also an initialization section
3970
4037
          ImplementationNode:=FindImplementationNode;
3971
4038
          InsertPos:=ImplementationNode.EndPos;
3972
 
          NewCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyKeyWord(
 
4039
          NewCode:=Beauty.BeautifyKeyWord(
3973
4040
                     'initialization')
3974
 
                   +SourceChangeCache.BeautifyCodeOptions.LineEnd
 
4041
                   +Beauty.LineEnd
3975
4042
                   +NewCode;
3976
4043
          if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,
3977
4044
                                           InsertPos,InsertPos,
3994
4061
  Result:=false;
3995
4062
  if SourceChangeCache=nil then exit;
3996
4063
  SourceChangeCache.MainScanner:=Scanner;
 
4064
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
3997
4065
  DebugLn('ConvertDelphiToLazarusSource AddModeDelphiDirective');
3998
4066
  if not AddModeDelphiDirective then exit;
3999
4067
  DebugLn('ConvertDelphiToLazarusSource RemoveDFMResourceDirective');
4223
4291
  InsertPos: Integer;
4224
4292
  InsertSrc: String;
4225
4293
  NearestCleanPos: integer;
 
4294
  Beauty: TBeautifyCodeOptions;
4226
4295
begin
4227
4296
  Result:=false;
4228
4297
  //DebugLn('TStandardCodeTool.AddResourcestring A ',NewIdentifier,'=',NewValue,' ');
4238
4307
  if (SectionNode=nil) then exit;
4239
4308
  SectionNode:=SectionNode.GetNodeOfType(ctnResStrSection);
4240
4309
  if SectionNode=nil then exit;
4241
 
  
 
4310
 
 
4311
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
4242
4312
  //DebugLn('TStandardCodeTool.AddResourcestring D SectionChilds=',SectionNode.FirstChild<>nil);
4243
4313
  // find insert position
4244
4314
  if SectionNode.FirstChild=nil then begin
4245
4315
    // no resourcestring in this section yet -> append as first child
4246
 
    Indent:=GetLineIndent(Src,SectionNode.StartPos)
4247
 
            +SourceChangeCache.BeautifyCodeOptions.Indent;
 
4316
    Indent:=Beauty.GetLineIndent(Src,SectionNode.StartPos)+Beauty.Indent;
4248
4317
    InsertPos:=SectionNode.StartPos+length('RESOURCESTRING');
4249
4318
  end else begin
4250
4319
    // search insert position
4263
4332
        end;
4264
4333
        if ANode=nil then begin
4265
4334
          // append new identifier as last
4266
 
          Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
 
4335
          Indent:=Beauty.GetLineIndent(Src,SectionNode.LastChild.StartPos);
4267
4336
          InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
4268
4337
        end else begin
4269
4338
          // insert in front of node
4270
 
          Indent:=GetLineIndent(Src,ANode.StartPos);
 
4339
          Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
4271
4340
          InsertPos:=FindLineEndOrCodeInFrontOfPosition(ANode.StartPos);
4272
4341
        end;
4273
4342
      end;
4291
4360
        end;
4292
4361
        if ANode=nil then begin
4293
4362
          // append new identifier as last
4294
 
          Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
 
4363
          Indent:=Beauty.GetLineIndent(Src,SectionNode.LastChild.StartPos);
4295
4364
          InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
4296
4365
        end else begin
4297
4366
          // insert behind node
4298
 
          Indent:=GetLineIndent(Src,ANode.StartPos);
 
4367
          Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
4299
4368
          InsertPos:=FindLineEndOrCodeAfterPosition(ANode.EndPos);
4300
4369
        end;
4301
4370
      end;
4303
4372
    else
4304
4373
      begin
4305
4374
        // append new identifier
4306
 
        Indent:=GetLineIndent(Src,SectionNode.LastChild.StartPos);
 
4375
        Indent:=Beauty.GetLineIndent(Src,SectionNode.LastChild.StartPos);
4307
4376
        InsertPos:=FindLineEndOrCodeAfterPosition(SectionNode.LastChild.EndPos);
4308
4377
      end;
4309
4378
    end;
4357
4426
  VarName, VarType: string; SourceChangeCache: TSourceChangeCache): boolean;
4358
4427
var ClassNode, SectionNode: TCodeTreeNode;
4359
4428
  Indent, InsertPos: integer;
 
4429
  Beauty: TBeautifyCodeOptions;
4360
4430
begin
4361
4431
  Result:=false;
4362
4432
  if (AClassName='') or (length(AClassName)>255) then
4380
4450
  and (SectionNode.NextBrother.Desc=ctnClassPublished) then
4381
4451
    SectionNode:=SectionNode.NextBrother;
4382
4452
  SourceChangeCache.MainScanner:=Scanner;
 
4453
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
4383
4454
  if SectionNode.FirstChild<>nil then begin
4384
 
    Indent:=GetLineIndent(Src,SectionNode.FirstChild.StartPos);
 
4455
    Indent:=Beauty.GetLineIndent(Src,SectionNode.FirstChild.StartPos);
4385
4456
  end else begin
4386
 
    Indent:=GetLineIndent(Src,SectionNode.StartPos)
4387
 
              +SourceChangeCache.BeautifyCodeOptions.Indent;
 
4457
    Indent:=Beauty.GetLineIndent(Src,SectionNode.StartPos)+Beauty.Indent;
4388
4458
  end;
4389
4459
  InsertPos:=FindLineEndOrCodeInFrontOfPosition(SectionNode.EndPos);
4390
4460
  SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
4391
 
          SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
4392
 
                     VarName+':'+VarType+';',Indent)
 
4461
          Beauty.BeautifyStatement(VarName+':'+VarType+';',Indent)
4393
4462
       );
4394
4463
  Result:=SourceChangeCache.Apply;
4395
4464
end;
5212
5281
  CleanCursorPos: integer;
5213
5282
  StartNode: TCodeTreeNode;
5214
5283
  InternalCursorAtEmptyLine: TExBool;
 
5284
  Beauty: TBeautifyCodeOptions;
5215
5285
 
5216
5286
  function CursorAtEmptyLine: Boolean;
5217
5287
  // true if cursor in empty line or at line end in front of an empty line
5343
5413
    // adjust indent of first line
5344
5414
    if FrontGap in [gtNone,gtSpace] then begin
5345
5415
      BeautifyFlags:=BeautifyFlags+[bcfDoNotIndentFirstLine];
5346
 
      NewCode:=GetIndentStr(Indent-GetPosInLine(Src,FromPos))+NewCode;
 
5416
      NewCode:=Beauty.GetIndentStr(Indent-GetPosInLine(Src,FromPos))+NewCode;
5347
5417
    end;
5348
5418
    // beautify
5349
 
    NewCode:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
 
5419
    NewCode:=Beauty.BeautifyStatement(
5350
5420
                     NewCode,Indent,BeautifyFlags);
5351
5421
 
5352
5422
    if AfterGap=gtNewLine then begin
5353
5423
      // do not reuse existing newline, but always add newline
5354
 
      NewCode:=NewCode+SourceChangeCache.BeautifyCodeOptions.LineEnd;
 
5424
      NewCode:=NewCode+Beauty.LineEnd;
5355
5425
      if (ToPos<SrcLen) and (not (Src[ToPos] in [#10,#13])) then
5356
 
        NewCode:=NewCode+GetIndentStr(GetLineIndent(Src,ToPos));
 
5426
        NewCode:=NewCode+Beauty.GetIndentStr(Beauty.GetLineIndent(Src,ToPos));
5357
5427
      AfterGap:=gtNone;
5358
5428
    end;
5359
5429
    {$IFDEF VerboseCompleteBlock}
5394
5464
      //DebugLn(['EndBlockIsOk ']);
5395
5465
      if (NeedCompletion>0) and (CursorBlockLvl>=0)
5396
5466
      and (Stack.Top=CursorBlockLvl)
5397
 
      and (GetLineIndent(Src,CurPos.StartPos)=CursorBlockOuterIndent) then begin
 
5467
      and (Beauty.GetLineIndent(Src,CurPos.StartPos)=CursorBlockOuterIndent) then begin
5398
5468
        // cursor block is properly closed => do not complete
5399
5469
        {$IFDEF VerboseCompleteBlock}
5400
5470
        debugln(['EndBlockIsOk cursor block is properly closed at ',CleanPosToStr(CurPos.StartPos)]);
5442
5512
      and (not PositionsInSameLine(Src,Stack.Stack[Stack.Top].StartPos,CurPos.StartPos))
5443
5513
      then begin
5444
5514
        // the first atom of this block is on a new line
5445
 
        Stack.Stack[Stack.Top].InnerIndent:=GetLineIndent(Src,CurPos.StartPos);
 
5515
        Stack.Stack[Stack.Top].InnerIndent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
5446
5516
        Stack.Stack[Stack.Top].InnerStartPos:=CurPos.StartPos;
5447
5517
      end;
5448
5518
 
5458
5528
          exit;
5459
5529
        end else begin
5460
5530
          CursorBlock:=Stack.Stack[CursorBlockLvl];
5461
 
          CursorBlockOuterIndent:=GetLineIndent(Src,CursorBlock.StartPos);
 
5531
          CursorBlockOuterIndent:=Beauty.GetLineIndent(Src,CursorBlock.StartPos);
5462
5532
          CursorBlockInnerIndent:=Stack.Stack[Stack.Top].InnerIndent;
5463
5533
          if (CursorBlockInnerIndent<=CursorBlockOuterIndent)
5464
5534
          and OnlyIfCursorBlockIndented then begin
5504
5574
      LineStart:=InCursorBlock and (LastPos>0)
5505
5575
                 and not PositionsInSameLine(Src,LastPos,CurPos.StartPos);
5506
5576
      if LineStart then
5507
 
        Indent:=GetLineIndent(Src,CurPos.StartPos);
 
5577
        Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
5508
5578
      if LineStart and (NeedCompletion=0) then begin
5509
5579
        // atom is in same block as cursor (not sub block)
5510
5580
        // and first atom of a line
5835
5905
          {$ENDIF}
5836
5906
          exit;
5837
5907
        end;
5838
 
        if (GetLineIndent(Src,BehindPos)>Indent) then begin
 
5908
        if (Beauty.GetLineIndent(Src,BehindPos)>Indent) then begin
5839
5909
          // code behind is more indented
5840
5910
          // for example
5841
5911
          //   repeat
5843
5913
          //     DoSomething;
5844
5914
          debugln(['CompleteStatements BehindPos ',dbgstr(copy(Src,BehindPos-8,8)),'|',dbgstr(copy(Src,BehindPos,8))]);
5845
5915
          {$IFDEF VerboseCompleteBlock}
5846
 
          DebugLn(['CompleteStatements code behind is indented more (Behind=',GetLineIndent(Src,BehindPos),' > Indent=',Indent,') => skip']);
 
5916
          DebugLn(['CompleteStatements code behind is indented more (Behind=',Beauty.GetLineIndent(Src,BehindPos),' > Indent=',Indent,') => skip']);
5847
5917
          {$ENDIF}
5848
5918
          exit;
5849
5919
        end;
5899
5969
  begin
5900
5970
    Result:=false;
5901
5971
    if CleanCursorPos<StartNode.StartPos then exit;
5902
 
    LastIndent:=GetLineIndent(Src,StartNode.Parent.StartPos);
 
5972
    LastIndent:=Beauty.GetLineIndent(Src,StartNode.Parent.StartPos);
5903
5973
    MoveCursorToNodeStart(StartNode);
5904
5974
    //debugln(['CompleteClassSection ',dbgstr(copy(Src,StartNode.StartPos-10,10)),'|',dbgstr(copy(Src,StartNode.StartPos,10))]);
5905
 
    Indent:=GetLineIndent(Src,CurPos.StartPos);
 
5975
    Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
5906
5976
    if Indent<LastIndent then
5907
5977
      LastIndent:=Indent;
5908
5978
    ReadNextAtom;
5926
5996
        end else
5927
5997
          exit(true);
5928
5998
      end else begin
5929
 
        Indent:=GetLineIndent(Src,CurPos.StartPos);
 
5999
        Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
5930
6000
        if Indent<LastIndent then begin
5931
6001
          { For example:
5932
6002
                TMyClass = class
5960
6030
  begin
5961
6031
    Result:=false;
5962
6032
    if CleanCursorPos<StartNode.StartPos then exit;
5963
 
    LastIndent:=GetLineIndent(Src,StartNode.StartPos);
 
6033
    LastIndent:=Beauty.GetLineIndent(Src,StartNode.StartPos);
5964
6034
    MoveCursorToNodeStart(StartNode);
5965
6035
    ReadNextAtom;
5966
6036
    if CleanCursorPos<CurPos.EndPos then exit(true);
5967
6037
    ReadNextAtom;
5968
6038
    if CurPos.Flag=cafEnd then exit(true);
5969
6039
    if CleanCursorPos<=CurPos.StartPos then begin
5970
 
      Indent:=GetLineIndent(Src,CurPos.StartPos);
 
6040
      Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
5971
6041
      InsertPos:=CleanCursorPos;
5972
6042
      if Indent<LastIndent then begin
5973
6043
        if not Replace('end;',InsertPos,InsertPos,LastIndent,
5992
6062
  begin
5993
6063
    Result:=false;
5994
6064
    if CleanCursorPos<StartNode.StartPos then exit;
5995
 
    LastIndent:=GetLineIndent(Src,StartNode.StartPos);
 
6065
    LastIndent:=Beauty.GetLineIndent(Src,StartNode.StartPos);
5996
6066
    MoveCursorToNodeStart(StartNode);
5997
6067
    ReadNextAtom; // record
5998
6068
    if CleanCursorPos<CurPos.EndPos then exit(true);
5999
6069
    ReadNextAtom;
6000
6070
    if CurPos.Flag=cafEnd then exit(true);
6001
6071
    if CleanCursorPos<=CurPos.StartPos then begin
6002
 
      Indent:=GetLineIndent(Src,CurPos.StartPos);
 
6072
      Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos);
6003
6073
      InsertPos:=CleanCursorPos;
6004
6074
      if Indent<=LastIndent then begin
6005
6075
        if not Replace('end;',InsertPos,InsertPos,LastIndent,
6023
6093
 
6024
6094
  InternalCursorAtEmptyLine:=ebNone;
6025
6095
  SourceChangeCache.MainScanner:=Scanner;
 
6096
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
6026
6097
  InitStack(Stack);
6027
6098
  try
6028
 
    //DebugLn(['TStandardCodeTool.CompleteBlock ',StartNode.DescAsString]);
 
6099
    {$IFDEF VerboseCompleteBlock}
 
6100
    DebugLn(['TStandardCodeTool.CompleteBlock ',StartNode.DescAsString]);
 
6101
    {$ENDIF}
6029
6102
 
6030
6103
    if StartNode.Desc in AllPascalStatements then begin
6031
6104
      while (StartNode.Parent<>nil)
6178
6251
  Indent: LongInt;
6179
6252
  InsertPos: Integer;
6180
6253
  AddSrc: String;
 
6254
  Beauty: TBeautifyCodeOptions;
6181
6255
begin
6182
6256
  Result:=false;
6183
6257
  BuildTree(lsrEnd);
 
6258
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
6184
6259
  // find an insert position
6185
6260
  ANode:=FindImplementationNode;
6186
6261
  if ANode<>nil then begin
6187
 
    Indent:=GetLineIndent(Src,ANode.StartPos);
 
6262
    Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
6188
6263
    InsertPos:=ANode.StartPos+length('implementation');
6189
6264
  end else begin
6190
6265
    ANode:=FindMainBeginEndNode;
6191
6266
    if ANode<>nil then begin
6192
 
      Indent:=GetLineIndent(Src,ANode.StartPos);
 
6267
      Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
6193
6268
      InsertPos:=ANode.StartPos;
6194
6269
    end else begin
6195
6270
      ANode:=FindMainUsesSection;
6196
6271
      if ANode<>nil then begin
6197
 
        Indent:=GetLineIndent(Src,ANode.StartPos);
 
6272
        Indent:=Beauty.GetLineIndent(Src,ANode.StartPos);
6198
6273
        InsertPos:=ANode.StartPos;
6199
6274
      end else begin
6200
6275
        Indent:=0;
6208
6283
  if NewSrc<>'' then
6209
6284
    AddSrc:=NewSrc
6210
6285
  else
6211
 
    AddSrc:=GetIndentStr(Indent)+'{$R '+Filename+'}';
 
6286
    AddSrc:=Beauty.GetIndentStr(Indent)+'{$R '+Filename+'}';
6212
6287
  if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
6213
6288
    AddSrc) then exit;
6214
6289
  if not SourceChangeCache.Apply then exit;
6275
6350
  Indent: LongInt;
6276
6351
  InsertPos: Integer;
6277
6352
  AddSrc: String;
 
6353
  Beauty: TBeautifyCodeOptions;
6278
6354
begin
6279
6355
  Result:=false;
6280
6356
  BuildTree(lsrEnd);
 
6357
  Beauty:=SourceChangeCache.BeautifyCodeOptions;
6281
6358
  // find an insert position
6282
6359
  ANode:=FindInitializationNode;
6283
6360
  if ANode<>nil then begin
6284
 
    Indent:=GetLineIndent(Src,ANode.StartPos)
6285
 
            +SourceChangeCache.BeautifyCodeOptions.Indent;
 
6361
    Indent:=Beauty.GetLineIndent(Src,ANode.StartPos)+Beauty.Indent;
6286
6362
    InsertPos:=ANode.StartPos+length('initialization');
6287
6363
  end else begin
6288
6364
    ANode:=FindMainBeginEndNode;
6290
6366
      MoveCursorToNodeStart(ANode);
6291
6367
      ReadNextAtom;
6292
6368
      //debugln(['TStandardCodeTool.AddIncludeDirective ',GetAtom]);
6293
 
      Indent:=GetLineIndent(Src,CurPos.StartPos)
6294
 
              +SourceChangeCache.BeautifyCodeOptions.Indent;
 
6369
      Indent:=Beauty.GetLineIndent(Src,CurPos.StartPos)+Beauty.Indent;
6295
6370
      InsertPos:=CurPos.EndPos;
6296
6371
    end else begin
6297
6372
      debugln(['TStandardCodeTool.AddIncludeDirective ToDo: add initialization / begin..end']);
6304
6379
  if NewSrc<>'' then
6305
6380
    AddSrc:=NewSrc
6306
6381
  else
6307
 
    AddSrc:=GetIndentStr(Indent)+'{$I '+Filename+'}';
 
6382
    AddSrc:=Beauty.GetIndentStr(Indent)+'{$I '+Filename+'}';
6308
6383
  if not SourceChangeCache.Replace(gtNewLine,gtNewLine,InsertPos,InsertPos,
6309
6384
    AddSrc) then exit;
6310
6385
  if not SourceChangeCache.Apply then exit;
6336
6411
    end;
6337
6412
  end;}
6338
6413
  
6339
 
  procedure Add(FilenameSrcPos: integer; const AFilename: string;
6340
 
    Found: boolean);
 
6414
  procedure Add(FilenameSrcPos: integer; const AFilename: string; Found: boolean);
6341
6415
  var
6342
6416
    NewFilename: String;
6343
6417
    p: PCodeXYPosition;
6360
6434
    end;
6361
6435
  end;
6362
6436
  
6363
 
  function SearchIncludeFilename(FilenameSrcPos: integer;
6364
 
    const AFilename: string): string;
 
6437
  function SearchIncludeFilename(FilenameSrcPos: integer; const AFilename: string): string;
6365
6438
  var
6366
6439
    AFilePath: String;
6367
6440
    BaseDir: String;
6383
6456
        AFilePath:=ExtractFilePath(Result);
6384
6457
        if AFilePath<>'' then begin
6385
6458
          // search relative to unit
 
6459
          //debugln(['SearchIncludeFilename BaseDir+Result=',BaseDir+Result]);
6386
6460
          CurFilename:=DirectoryCache.Pool.FindDiskFilename(BaseDir+Result,true);
6387
 
          Result:=copy(CurFilename,length(BaseDir)+1,length(CurFilename));
 
6461
          //debugln(['SearchIncludeFilename DiskFilename=',CurFilename]);
 
6462
          Result:=CreateRelativePath(CurFilename,BaseDir);
 
6463
          //debugln(['SearchIncludeFilename RelativeDiskFilename=',Result]);
6388
6464
          if FileExistsCached(CurFilename) then
6389
6465
            Add(FilenameSrcPos,CurFilename,true)
6390
6466
          else
6399
6475
            if Scanner.Values.IsDefined('DELPHI') then
6400
6476
              PathDivider:=':'
6401
6477
          end;
6402
 
          CurFilename:=SearchFileInPath(Result,BaseDir,IncludePath,PathDivider,
6403
 
                                   ctsfcAllCase);
 
6478
          CurFilename:=SearchFileInPath(Result,BaseDir,IncludePath,PathDivider, ctsfcAllCase);
6404
6479
          if CurFilename<>'' then begin
6405
6480
            // found
6406
6481
            Result:=CreateRelativePath(CurFilename,BaseDir);
6429
6504
    OldFilename: String;
6430
6505
    AFilename: String;
6431
6506
  begin
6432
 
    OldFilename:=SetDirSeparators(copy(ASource,StartPos,EndPos-StartPos));
 
6507
    OldFilename:=GetForcedPathDelims(copy(ASource,StartPos,EndPos-StartPos));
6433
6508
    //DebugLn('FixFilename ',dbgs(StartPos),' ',dbgs(EndPos),' ',OldFilename);
6434
6509
    AFilename:=OldFilename;
6435
6510
    if ExtractFileExt(AFilename)='' then begin
6441
6516
    end;
6442
6517
    AFilename:=SearchIncludeFilename(StartPos,AFilename);
6443
6518
    if OldFilename<>AFilename then begin
6444
 
      DebugLn('FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"');
 
6519
      DebugLn('TStandardCodeTool.FixIncludeFilenames.FixFilename replacing in '+Code.Filename+' include directive "',OldFilename,'" with "',AFilename,'"');
6445
6520
      SourceChangeCache.ReplaceEx(gtNone,gtNone,0,0,Code,StartPos,EndPos,AFilename);
6446
6521
    end;
6447
6522
  end;
6582
6657
      or ((BlockType=bkwRepeat) and (CurBlockWord=bkwUntil)) then begin
6583
6658
        // block end found
6584
6659
        if (MinCleanPos<=CurPos.StartPos)
6585
 
        and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
 
6660
        and (Beautifier.GetLineIndent(Src,CurPos.StartPos)<>Beautifier.GetLineIndent(Src,BlockStart))
6586
6661
        then begin
6587
6662
          // different indent -> unclosed block found
6588
 
          if GetLineIndent(Src,BlockStart)>GetLineIndent(Src,CurPos.StartPos)
 
6663
          if Beautifier.GetLineIndent(Src,BlockStart)>Beautifier.GetLineIndent(Src,CurPos.StartPos)
6589
6664
          then begin
6590
6665
            // the current block is more indented than the next block
6591
6666
            // -> probably the current block misses a block end
6607
6682
      begin
6608
6683
        // try..finally, try..except found
6609
6684
        if (MinCleanPos<=CurPos.StartPos)
6610
 
        and (GetLineIndent(Src,CurPos.StartPos)<>GetLineIndent(Src,BlockStart))
 
6685
        and (Beautifier.GetLineIndent(Src,CurPos.StartPos)<>Beautifier.GetLineIndent(Src,BlockStart))
6611
6686
        then begin
6612
6687
          // different indent -> unclosed block found
6613
6688
          //   probably a block start is missing, so the error position is
6642
6717
      else
6643
6718
      begin
6644
6719
        // unexpected keyword found
6645
 
        if GetLineIndent(Src,BlockStart)>=GetLineIndent(Src,CurPos.StartPos)
 
6720
        if Beautifier.GetLineIndent(Src,BlockStart)>=Beautifier.GetLineIndent(Src,CurPos.StartPos)
6646
6721
        then begin
6647
6722
          // the current block is more or equal indented than the next block
6648
6723
          // -> probably the current block misses a block end
6660
6735
// this function reads any bracket
6661
6736
// (the ReadTilBracketClose function reads only brackets in code, not comments)
6662
6737
var OpenBracket: char;
6663
 
  CommentLvl: integer;
6664
6738
begin
6665
6739
  Result:=false;
6666
6740
  OpenBracket:=Src[CurPos.StartPos];
6667
6741
  if OpenBracket='{' then begin
6668
6742
    // read til end of comment
6669
 
    CommentLvl:=1;
6670
 
    inc(CurPos.StartPos);
6671
 
    while (CurPos.StartPos<=SrcLen) and (CommentLvl>0) do begin
6672
 
      case Src[CurPos.StartPos] of
6673
 
      '{': if Scanner.NestedComments then inc(CommentLvl);
6674
 
      '}':
6675
 
        if CommentLvl=1 then begin
6676
 
          Result:=true;
6677
 
          break;
6678
 
        end else
6679
 
          dec(CommentLvl);
6680
 
      end;
6681
 
      inc(CurPos.StartPos);
6682
 
    end;
 
6743
    CurPos.StartPos:=FindCommentEnd(Src,CurPos.StartPos,Scanner.NestedComments);
 
6744
    Result:=CurPos.StartPos<=SrcLen;
6683
6745
  end else if OpenBracket='(' then begin
6684
6746
    if (CurPos.StartPos<SrcLen) and (Src[CurPos.StartPos+1]='*') then begin
6685
6747
      // read til end of comment
6686
 
      inc(CurPos.StartPos,3);
6687
 
      while true do begin
6688
 
        if (CurPos.StartPos<=SrcLen)
6689
 
        and ((Src[CurPos.StartPos-1]='*') and (Src[CurPos.StartPos]=')')) then
6690
 
        begin
6691
 
          Result:=true;
6692
 
          exit;
6693
 
        end;
6694
 
        inc(CurPos.StartPos);
6695
 
      end;
 
6748
      CurPos.StartPos:=FindCommentEnd(Src,CurPos.StartPos,Scanner.NestedComments);
 
6749
      Result:=CurPos.StartPos<=SrcLen;
6696
6750
    end else begin
 
6751
      // round bracket operator
6697
6752
      Result:=ReadTilBracketClose(false);
6698
6753
    end;
6699
6754
  end else if OpenBracket='[' then begin
6712
6767
  OpenBracket:=Src[CurPos.StartPos];
6713
6768
  if OpenBracket='}' then begin
6714
6769
    // read backwards til end of comment
6715
 
    CommentLvl:=1;
6716
6770
    dec(CurPos.StartPos);
6717
 
    while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
6718
 
      case Src[CurPos.StartPos] of
6719
 
      '}': if Scanner.NestedComments then inc(CommentLvl);
6720
 
      '{':
6721
 
        if CommentLvl=1 then begin
6722
 
          Result:=true;
 
6771
    if (CurPos.StartPos>0) and (Src[CurPos.StartPos]=#3) then begin
 
6772
      // codetools skip comment
 
6773
      dec(CurPos.StartPos);
 
6774
      while (CurPos.StartPos>=1) do begin
 
6775
        if (Src[CurPos.StartPos]=#3) and (CurPos.StartPos>1)
 
6776
        and (Src[CurPos.StartPos-1]='}') then begin
 
6777
          dec(CurPos.StartPos,2);
6723
6778
          break;
6724
 
        end else
6725
 
          dec(CommentLvl);
6726
 
      end;
6727
 
      dec(CurPos.StartPos);
 
6779
        end;
 
6780
        dec(CurPos.StartPos);
 
6781
      end;
 
6782
    end else begin
 
6783
      // pascal comment
 
6784
      CommentLvl:=1;
 
6785
      while (CurPos.StartPos>=1) and (CommentLvl>0) do begin
 
6786
        case Src[CurPos.StartPos] of
 
6787
        '}': if Scanner.NestedComments then inc(CommentLvl);
 
6788
        '{':
 
6789
          if CommentLvl=1 then begin
 
6790
            Result:=true;
 
6791
            break;
 
6792
          end else
 
6793
            dec(CommentLvl);
 
6794
        end;
 
6795
        dec(CurPos.StartPos);
 
6796
      end;
6728
6797
    end;
6729
6798
  end else if OpenBracket=')' then begin
6730
6799
    if (CurPos.StartPos>1) and (Src[CurPos.StartPos-1]='*') then begin