Skip to content

Commit 1e10755

Browse files
CWBuddeCWBudde
committed
Added language server code
1 parent 0a37d77 commit 1e10755

File tree

2 files changed

+324
-0
lines changed

2 files changed

+324
-0
lines changed

‎Server/dwsls.Main.pas‎

Lines changed: 306 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,306 @@
1+
unit dwsls.Main;
2+
3+
interface
4+
5+
uses
6+
Windows, Classes, Variants, dwsJson, dwsXPlatform, dwsUtils;
7+
8+
type
9+
TDWScriptLanguageServer = class
10+
private
11+
FInputStream: THandleStream;
12+
FOutputStream: THandleStream;
13+
FCurrentId: Integer;
14+
{$IFDEF DEBUG}
15+
FLog: TStringList;
16+
procedure Log(Text: string);
17+
{$ENDIF}
18+
function HandleInput(Text: AnsiString): Boolean;
19+
function HandleJsonRpc(JsonRpc: TdwsJSONObject): Boolean;
20+
procedure WriteOutput(Text: AnsiString);
21+
procedure SendResponse(Result: Variant; Error: TdwsJSONObject = nil); overload;
22+
procedure SendResponse(Result: TdwsJSONObject; Error: TdwsJSONObject = nil); overload;
23+
procedure HandleInitialize(Params: TdwsJSONObject);
24+
procedure HandleShutDown;
25+
procedure HandleExit;
26+
procedure HandleInitialized;
27+
procedure HandleWorkspaceChangeConfiguration;
28+
public
29+
constructor Create;
30+
destructor Destroy; override;
31+
32+
procedure Run;
33+
end;
34+
35+
implementation
36+
37+
uses
38+
SysUtils;
39+
40+
{ TDWScriptLanguageServer }
41+
42+
constructor TDWScriptLanguageServer.Create;
43+
var
44+
Security: TSecurityAttributes;
45+
begin
46+
FInputStream := THandleStream.Create(GetStdHandle(STD_INPUT_HANDLE));
47+
FOutputStream := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE));
48+
{$IFDEF DEBUG}
49+
FLog := TStringList.Create;
50+
{$ENDIF}
51+
end;
52+
53+
destructor TDWScriptLanguageServer.Destroy;
54+
begin
55+
FInputStream.Free;
56+
FOutputStream.Free;
57+
{$IFDEF DEBUG}
58+
FLog.Free;
59+
{$ENDIF}
60+
61+
inherited;
62+
end;
63+
64+
{$IFDEF DEBUG}
65+
procedure TDWScriptLanguageServer.Log(Text: string);
66+
begin
67+
FLog.Add(Text);
68+
FLog.SaveToFile('A:\Input.txt');
69+
end;
70+
{$ENDIF}
71+
72+
procedure TDWScriptLanguageServer.HandleInitialize(Params: TdwsJSONObject);
73+
var
74+
InitializeResult: TdwsJSONObject;
75+
Capabilities: TdwsJSONObject;
76+
TextDocumentSyncOptions: TdwsJSONObject;
77+
SaveOptions: TdwsJSONObject;
78+
CompletionOptions: TdwsJSONObject;
79+
TriggerCharacters: TdwsJSONArray;
80+
SignatureHelpOptions: TdwsJSONObject;
81+
CodeLensOptions: TdwsJSONObject;
82+
DocumentOnTypeFormattingOptions: TdwsJSONObject;
83+
DocumentLinkOptions: TdwsJSONObject;
84+
ExecuteCommandOptions: TdwsJSONObject;
85+
Commands: TdwsJSONArray;
86+
begin
87+
InitializeResult := TdwsJSONObject.Create;
88+
Capabilities := InitializeResult.AddObject('capabilities');
89+
90+
// text document sync options
91+
TextDocumentSyncOptions := Capabilities.AddObject('textDocumentSync');
92+
TextDocumentSyncOptions.AddValue('openClose', true);
93+
// TextDocumentSyncOptions.AddValue('change', 0);
94+
TextDocumentSyncOptions.AddValue('willSave', true);
95+
TextDocumentSyncOptions.AddValue('willSaveWaitUntil', true);
96+
SaveOptions := TextDocumentSyncOptions.AddObject('save');
97+
SaveOptions.AddValue('includeText', true);
98+
99+
// completion options
100+
CompletionOptions := Capabilities.AddObject('save');
101+
CompletionOptions.AddValue('resolveProvider', true);
102+
TriggerCharacters := CompletionOptions.AddArray('triggerCharacters');
103+
TriggerCharacters.Add('.');
104+
105+
// signature help options
106+
SignatureHelpOptions := Capabilities.AddObject('signatureHelpProvider');
107+
TriggerCharacters := CompletionOptions.AddArray('triggerCharacters');
108+
109+
Capabilities.AddValue('hoverProvider', true);
110+
Capabilities.AddValue('definitionProvider', true);
111+
Capabilities.AddValue('referencesProvider', true);
112+
Capabilities.AddValue('documentHighlightProvider', true);
113+
Capabilities.AddValue('documentSymbolProvider', true);
114+
Capabilities.AddValue('workspaceSymbolProvider', true);
115+
Capabilities.AddValue('codeActionProvider', true);
116+
117+
// Code Lens options
118+
CodeLensOptions := Capabilities.AddObject('codeLensProvider');
119+
CodeLensOptions.AddValue('resolveProvider', true);
120+
121+
Capabilities.AddValue('documentFormattingProvider', true);
122+
Capabilities.AddValue('documentRangeFormattingProvider', true);
123+
124+
(*
125+
// Format document on type options
126+
DocumentOnTypeFormattingOptions := Capabilities.AddObject('documentOnTypeFormattingProvider');
127+
DocumentOnTypeFormattingOptions.AddValue('firstTriggerCharacter', '');
128+
TriggerCharacters := CompletionOptions.AddArray('moreTriggerCharacter');
129+
*)
130+
131+
Capabilities.AddValue('renameProvider', true);
132+
133+
DocumentLinkOptions := Capabilities.AddObject('documentLinkProvider');
134+
DocumentLinkOptions.AddValue('resolveProvider', true);
135+
136+
(*
137+
ExecuteCommandOptions := Capabilities.AddObject('executeCommandProvider');
138+
Commands := ExecuteCommandOptions.AddArray('commands')
139+
*)
140+
141+
SendResponse(InitializeResult);
142+
end;
143+
144+
procedure TDWScriptLanguageServer.HandleInitialized;
145+
begin
146+
// nothing here so far
147+
end;
148+
149+
procedure TDWScriptLanguageServer.HandleShutDown;
150+
begin
151+
SendResponse(null);
152+
end;
153+
154+
procedure TDWScriptLanguageServer.HandleExit;
155+
begin
156+
// yet to do
157+
end;
158+
159+
procedure TDWScriptLanguageServer.HandleWorkspaceChangeConfiguration;
160+
begin
161+
// yet to do
162+
end;
163+
164+
function TDWScriptLanguageServer.HandleJsonRpc(JsonRpc: TdwsJSONObject): Boolean;
165+
var
166+
Method: string;
167+
Sequence: Integer;
168+
Body: TdwsJSONObject;
169+
begin
170+
Result := False;
171+
if not Assigned(JsonRpc['id']) then
172+
begin
173+
OutputDebugString('Incomplete JSON RPC - "id" is missing');
174+
Exit;
175+
end;
176+
FCurrentId := JsonRpc['id'].AsInteger;
177+
178+
if not Assigned(JsonRpc['method']) then
179+
begin
180+
OutputDebugString('Incomplete JSON RPC - "method" is missing');
181+
Exit;
182+
end;
183+
Method := JsonRpc['method'].AsString;
184+
185+
if Method = 'initialize' then
186+
HandleInitialize(TdwsJSONObject(JsonRpc['params']))
187+
else
188+
if Method = 'initialized' then
189+
HandleInitialized
190+
else
191+
if Method = 'shutdown' then
192+
HandleShutDown
193+
else
194+
if Pos('workspace', Method) = 1 then
195+
begin
196+
// workspace related messages
197+
if Method = 'workspace/didChangeConfiguration' then
198+
HandleWorkspaceChangeConfiguration;
199+
end
200+
else
201+
if Method = 'exit' then
202+
begin
203+
HandleExit;
204+
Result := True;
205+
end
206+
{$IFDEF DEBUG}
207+
else
208+
Log('UnknownMessage: ' + JsonRpc.AsString);
209+
{$ENDIF}
210+
end;
211+
212+
function TDWScriptLanguageServer.HandleInput(Text: AnsiString): Boolean;
213+
var
214+
Header: string;
215+
SplitterPos: Integer;
216+
JsonValue: TdwsJSONValue;
217+
begin
218+
Result := False;
219+
220+
SplitterPos := Pos(#13#10#13#10, Text);
221+
if SplitterPos < 0 then
222+
Exit;
223+
224+
Header := Copy(Text, 1, SplitterPos - 1);
225+
226+
Delete(Text, 1, SplitterPos + 3);
227+
228+
JsonValue := TdwsJSONObject.ParseString(Text);
229+
if JsonValue.Items['jsonrpc'].AsString <> '2.0' then
230+
begin
231+
OutputDebugString('Unknown jsonrpc format');
232+
Exit;
233+
end;
234+
235+
Result := HandleJsonRpc(TdwsJSONObject(JsonValue));
236+
end;
237+
238+
procedure TDWScriptLanguageServer.SendResponse(Result: Variant; Error: TdwsJSONObject = nil);
239+
var
240+
Response: TdwsJSONObject;
241+
begin
242+
Response := TdwsJSONObject.Create;
243+
Response.AddValue('id', FCurrentId);
244+
if VarIsStr(Result) then
245+
Response.AddValue('result', VariantToString(Result))
246+
else
247+
if VarIsOrdinal(Result) then
248+
Response.AddValue('result', VariantToInt64(Result))
249+
else
250+
if VarIsFloat(Result) then
251+
Response.AddValue('result', VariantToFloat(Result));
252+
253+
if Assigned(Error) then
254+
Response.Add('error', Error);
255+
WriteOutput(Response.ToString);
256+
end;
257+
258+
procedure TDWScriptLanguageServer.SendResponse(Result, Error: TdwsJSONObject);
259+
var
260+
Response: TdwsJSONObject;
261+
begin
262+
Response := TdwsJSONObject.Create;
263+
Response.AddValue('jsonrpc', '2.0');
264+
Response.AddValue('id', FCurrentId);
265+
Response.Add('result', Result);
266+
if Assigned(Error) then
267+
Response.Add('error', Error);
268+
WriteOutput(Response.ToString);
269+
end;
270+
271+
procedure TDWScriptLanguageServer.WriteOutput(Text: AnsiString);
272+
begin
273+
Text := 'Content-Length: ' + IntToStr(Length(Text)) + #13#10#13#10 + Text;
274+
275+
FOutputStream.Write(Text[1], Length(Text));
276+
end;
277+
278+
procedure TDWScriptLanguageServer.Run;
279+
var
280+
Text: AnsiString;
281+
NewText: AnsiString;
282+
begin
283+
Text := '';
284+
repeat
285+
repeat
286+
sleep(100);
287+
until (FInputStream.Size > FInputStream.Position);
288+
SetLength(NewText, FInputStream.Size - FInputStream.Position);
289+
FInputStream.Read(NewText[1], FInputStream.Size - FInputStream.Position);
290+
291+
Text := Text + NewText;
292+
293+
{$IFDEF DEBUG}
294+
Log(Text);
295+
{$ENDIF}
296+
297+
if AnsiPos(#13#10, Text) > 0 then
298+
begin
299+
if HandleInput(Text) then
300+
Exit;
301+
Text := '';
302+
end;
303+
until False;
304+
end;
305+
306+
end.

‎Server/dwsls.dpr‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
program dwsls;
2+
3+
{$APPTYPE CONSOLE}
4+
5+
{$R *.res}
6+
7+
uses
8+
System.SysUtils,
9+
dls.Main in 'dls.Main.pas';
10+
11+
var
12+
LanguageServer: TDWScriptLanguageServer;
13+
14+
begin
15+
LanguageServer := TDWScriptLanguageServer.Create;
16+
LanguageServer.Run;
17+
end.
18+

0 commit comments

Comments
 (0)