pascal-language-server/src/serverprotocol/PasLS.CodeToolHelper.pas at 9ff27cc83e13aede5f6e2adcb712fbd6c9aa34ea · genericptr/pascal-language-server · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
unit PasLS.CodeToolHelper;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, FileProcs, LazUtilities,
  // Codetools
  ExprEval, DefineTemplates, CodeToolManager, CodeCache, LinkScanner, sourcelog,
  BasicCodeTools,
  // LSP
  LSP.Messages;

type
  { TCodeToolManagerHelper }

  TCodeToolManagerHelper = class helper for TCodeToolManager
  public
    procedure WriteDefinesDebugReport(Transport: TMessageTransport);
    procedure WriteUnitDirectives(Code: TCodeBuffer; Transport: TMessageTransport);
    procedure WriteUnitInfo(Code: TCodeBuffer; Transport: TMessageTransport);
  end;

implementation

{ TCodeToolManagerHelper }

procedure TCodeToolManagerHelper.WriteDefinesDebugReport(Transport: TMessageTransport);
// let the codetools calculate the defines for the directory
var
  Report: TStringList;

  procedure AddNodeReport(Prefix: string; DefTempl: TDefineTemplate);
  var
    s: string;
  begin
    while DefTempl <> nil do
    begin
      s := Prefix + 'Name="' + DefTempl.Name + '"';
      s := s + ' Description="' + DefTempl.Description + '"';
      s := s + ' Action="' + DefineActionNames[DefTempl.Action] + '"';
      s := s + ' Variable="' + DefTempl.Variable + '"';
      s := s + ' Value="' + dbgstr(DefTempl.Value) + '"';
      Report.Add(s);
      if DefTempl.FirstChild <> nil then
        AddNodeReport(Prefix + '    ', DefTempl.FirstChild);
      DefTempl := DefTempl.Next;
    end;
  end;

var
  Dir: string;
  Defines: TExpressionEvaluator;
  i: integer;
  LocalDefineTree: TDefineTree;
begin
  Dir := ExpandFileName(GetCurrentDir);
  LocalDefineTree := Self.DefineTree;

  Defines := LocalDefineTree.GetDefinesForDirectory(Dir, False);

  Report := TStringList.Create;
  try
    Report.Add('Directory: ' + Dir);
    if Defines <> nil then
    begin
      Report.Add('Defines:');
      for i := 0 to Defines.Count - 1 do
      begin
        Report.Add(Defines.Names(i) + '=' + dbgstr(Defines.Values(i)));
      end;
      Report.Add('');
    end;

    // add all nodes to report
    Report.Add('Tree:');
    AddNodeReport('  ', LocalDefineTree.RootTemplate);
  finally
    Transport.SendDiagnostic(Report.Text);
    FreeAndNil(Report);
  end;
end;

procedure TCodeToolManagerHelper.WriteUnitDirectives(Code: TCodeBuffer; Transport: TMessageTransport);
var
  Scanner: TLinkScanner;
  i: Integer;
  Dir: PLSDirective;
  FirstSortedIndex: integer;
  LastSortedIndex: integer;
  Report: TStringList;
begin
  if Code = nil then
    exit;

  // parse the unit
  if not Self.ExploreUnitDirectives(Code, Scanner) then
    raise Exception.Create('parser error');

  Report := TStringList.Create;
  try
    Report.Add('Scanner Debug Report:');
    Report.Add('-----------------------------------------------');
    Report.Add('CleanedSrc:');
    Report.Add(Scanner.CleanedSrc);
    Report.Add('-----------------------------------------------');
    Report.Add('Directives in compile order:');
    for i := 0 to Scanner.DirectiveCount - 1 do begin
      Dir := Scanner.Directives[i];
      Report.Add(Format('%d/%d CleanPos=%d=%s Level=%d %s "%s"',
        [i, Scanner.DirectiveCount,
         Dir^.CleanPos, Scanner.CleanedPosToStr(Dir^.CleanPos),
         Dir^.Level, dbgs(Dir^.State),
         ExtractCommentContent(Scanner.CleanedSrc, Dir^.CleanPos, Scanner.NestedComments)]));
    end;
    Report.Add('-----------------------------------------------');
    Report.Add('Directives sorted for Code and SrcPos:');
    for i := 0 to Scanner.DirectiveCount - 1 do begin
      Dir := Scanner.DirectivesSorted[i];
      Report.Add(Format('%d/%d CleanPos=%d=%s Level=%d %s "%s"',
        [i, Scanner.DirectiveCount,
         Dir^.CleanPos, Scanner.CleanedPosToStr(Dir^.CleanPos),
         Dir^.Level, dbgs(Dir^.State),
         ExtractCommentContent(Scanner.CleanedSrc, Dir^.CleanPos, Scanner.NestedComments)]));
      if Scanner.FindDirective(Code, Dir^.SrcPos, FirstSortedIndex, LastSortedIndex) then
      begin
        if FirstSortedIndex < LastSortedIndex then
          Report.Add(Format(' MULTIPLE: %d-%d', [FirstSortedIndex, LastSortedIndex]));
      end
      else
      begin
        raise Exception.Create('inconsistency: Scanner.FindDirective failed');
      end;
    end;
    Report.Add('-----------------------------------------------');

    Transport.SendDiagnostic(Report.Text);
  finally
    FreeAndNil(Report);
  end;
end;

procedure TCodeToolManagerHelper.WriteUnitInfo(Code: TCodeBuffer; Transport: TMessageTransport);
var
  Report: TStringList;
begin
  Report := TStringList.Create;
  try
    Report.Add('show unit info');
    Report.Add('UnitPath:');
    Report.Add(Self.GetUnitPathForDirectory(Code.Filename));

    Report.Add('IncPath:');
    Report.Add(Self.GetIncludePathForDirectory(Code.Filename));

    Report.Add('SrcPath:');
    Report.Add(Self.GetCompleteSrcPathForDirectory(Code.Filename));

    Transport.SendDiagnostic(Report.Text);
  finally
    FreeAndNil(Report);
  end;
end;

end.