├── COPYING
├── README.md
├── Sample-Formatting.cfg
├── images
└── vscodedebug.png
└── src
├── pascallanguageserver.lpg
├── protocol
├── LSP.Base.pas
├── LSP.BaseTypes.pas
├── LSP.Basic.pas
├── LSP.Capabilities.pas
├── LSP.CodeAction.pas
├── LSP.Completion.pas
├── LSP.Diagnostics.pas
├── LSP.DocumentHighlight.pas
├── LSP.DocumentSymbol.pas
├── LSP.ExecuteCommand.pas
├── LSP.General.pas
├── LSP.Hover.pas
├── LSP.InlayHint.pas
├── LSP.Messages.pas
├── LSP.Options.pas
├── LSP.References.pas
├── LSP.SignatureHelp.pas
├── LSP.Streaming.pas
├── LSP.Synchronization.pas
├── LSP.Window.pas
├── LSP.WorkDoneProgress.pas
├── LSP.Workspace.pas
├── PasLS.Settings.pas
├── PasLS.SocketDispatcher.pas
├── PasLS.TextLoop.pas
├── lspprotocol.lpk
├── lspprotocol.pas
└── memutils.pas
├── proxy
├── PasLSProxy.Config.pas
├── paslsproxy.lpi
└── paslsproxy.lpr
├── serverprotocol
├── PasLS.AllCommands.pas
├── PasLS.ApplyEdit.pas
├── PasLS.CheckInactiveRegions.pas
├── PasLS.CodeAction.pas
├── PasLS.CodeUtils.pas
├── PasLS.Command.CompleteCode.pas
├── PasLS.Command.FormatCode.pas
├── PasLS.Command.InvertAssignment.pas
├── PasLS.Command.RemoveEmptyMethods.pas
├── PasLS.Commands.pas
├── PasLS.Completion.pas
├── PasLS.Diagnostics.pas
├── PasLS.DocumentHighlight.pas
├── PasLS.DocumentSymbol.pas
├── PasLS.ExecuteCommand.pas
├── PasLS.Formatter.pas
├── PasLS.General.pas
├── PasLS.GotoDeclaration.pas
├── PasLS.GotoDefinition.pas
├── PasLS.GotoImplementation.pas
├── PasLS.Hover.pas
├── PasLS.InactiveRegions.pas
├── PasLS.InlayHint.pas
├── PasLS.InvertAssign.pas
├── PasLS.LazConfig.pas
├── PasLS.Parser.pas
├── PasLS.References.pas
├── PasLS.RemoveEmptyMethods.pas
├── PasLS.Settings.pas
├── PasLS.SignatureHelp.pas
├── PasLS.Symbols.pas
├── PasLS.Synchronization.pas
├── PasLS.Workspace.pas
├── lspserver.lpk
└── lspserver.pas
├── socketserver
├── PasLSSock.Config.pas
├── paslssock.lpi
└── paslssock.lpr
├── standard
├── PasLS.LSConfig.pas
├── pasls.lpi
└── pasls.lpr
└── tests
├── Tests.Basic.pas
├── testlsp.lpi
└── testlsp.lpr
/images/vscodedebug.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/genericptr/pascal-language-server/5202e1a0c852f2dfe23825a060246978a49ecaf8/images/vscodedebug.png
--------------------------------------------------------------------------------
/src/pascallanguageserver.lpg:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/protocol/LSP.BaseTypes.pas:
--------------------------------------------------------------------------------
1 | // Copyright 2023 Michael Van Canneyt
2 | // This file is part of Pascal Language Server.
3 |
4 | // Pascal Language Server is free software: you can redistribute it
5 | // and/or modify it under the terms of the GNU General Public License
6 | // as published by the Free Software Foundation, either version 3 of
7 | // the License, or (at your option) any later version.
8 |
9 | // Pascal Language Server is distributed in the hope that it will be
10 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
11 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 | // GNU General Public License for more details.
13 |
14 | // You should have received a copy of the GNU General Public License
15 | // along with Pascal Language Server. If not, see
16 | // .
17 | unit LSP.BaseTypes;
18 |
19 | {$mode objfpc}{$H+}
20 |
21 | interface
22 |
23 | uses
24 | Classes, SysUtils;
25 |
26 | Type
27 | TAnyArray = array of Variant;
28 |
29 | { TOptional }
30 |
31 | generic TOptional = class
32 | private
33 | fHasValue: Boolean;
34 | fValue: T;
35 | function GetValue: T;
36 | procedure SetValue(AValue: T);
37 | public
38 | property HasValue: Boolean read fHasValue;
39 | property Value: T read GetValue write SetValue;
40 | procedure Clear;
41 | end;
42 |
43 | { TOptionalVariantBase }
44 |
45 | TOptionalVariantBase = class(specialize TOptional);
46 |
47 | { TOptionalVariant }
48 |
49 | generic TOptionalVariant = class(TOptionalVariantBase)
50 | private
51 | function GetValue: T;
52 | procedure SetValue(AValue: T);
53 | public
54 | constructor Create; overload;
55 | constructor Create(AValue: T); overload;
56 | property Value: T read GetValue write SetValue;
57 | end;
58 |
59 | { TOptionalObjectBase }
60 |
61 | TOptionalObjectBase = class(specialize TOptional)
62 | public
63 | function ValueClass: TClass; virtual; abstract;
64 | end;
65 |
66 | { TOptionalObject }
67 |
68 | generic TOptionalObject = class(TOptionalObjectBase)
69 | private
70 | function GetValue: T;
71 | procedure SetValue(AValue: T);
72 | public
73 | constructor Create;
74 | constructor Create(AValue: T);
75 | function ValueClass: TClass; override;
76 | property Value: T read GetValue write SetValue;
77 | end;
78 |
79 | TOptionalBoolean = specialize TOptionalVariant;
80 | TOptionalString = specialize TOptionalVariant;
81 | TOptionalInteger = specialize TOptionalVariant;
82 | TOptionalAny = specialize TOptionalVariant; // any type except structures (objects or arrays)
83 | TOptionalNumber = TOptionalInteger;
84 |
85 | { TGenericCollection }
86 |
87 | generic TGenericCollection = class(TCollection)
88 | private
89 | function GetI(Index : Integer): T;
90 | procedure SetI(Index : Integer; AValue: T);
91 | public
92 | constructor Create;
93 | Function Add : T; reintroduce;
94 | Property Items[Index : Integer] : T Read GetI Write SetI;
95 | end;
96 |
97 | { TLSPStreamable }
98 |
99 | TLSPStreamable = class(TPersistent)
100 | Public
101 | // We need a virtual constructor
102 | Constructor Create; virtual;
103 | end;
104 | TLSPStreamableClass = Class of TLSPStreamable;
105 |
106 |
107 | { LSPException }
108 |
109 | LSPException = class(Exception)
110 | public
111 | function Code: Integer; virtual; abstract;
112 | end;
113 |
114 | EServerNotInitialized = class(LSPException)
115 | public
116 | function Code: Integer; override;
117 | end;
118 |
119 | EUnknownErrorCode = class(LSPException)
120 | public
121 | function Code: Integer; override;
122 | end;
123 |
124 | // Defined by the protocol.
125 | ERequestCancelled = class(LSPException)
126 | public
127 | function Code: Integer; override;
128 | end;
129 |
130 | EContentModified = class(LSPException)
131 | public
132 | function Code: Integer; override;
133 | end;
134 |
135 | operator :=(right: Boolean): TOptionalAny;
136 | operator :=(right: Integer): TOptionalAny;
137 | operator :=(right: String): TOptionalAny;
138 |
139 | operator :=(right: Boolean): TOptionalBoolean;
140 | operator :=(right: Integer): TOptionalInteger;
141 | operator :=(right: String): TOptionalString;
142 |
143 |
144 | implementation
145 |
146 | { Utilities }
147 |
148 | operator :=(right: Boolean): TOptionalAny;
149 | begin
150 | result := TOptionalAny.Create(right);
151 | end;
152 |
153 | operator :=(right: Integer): TOptionalAny;
154 | begin
155 | result := TOptionalAny.Create(right);
156 | end;
157 |
158 | operator :=(right: String): TOptionalAny;
159 | begin
160 | result := TOptionalAny.Create(right);
161 | end;
162 |
163 | operator :=(right: Boolean): TOptionalBoolean;
164 | begin
165 | result := TOptionalBoolean.Create(right);
166 | end;
167 |
168 | operator :=(right: Integer): TOptionalInteger;
169 | begin
170 | result := TOptionalInteger.Create(right);
171 | end;
172 |
173 | operator :=(right: String): TOptionalString;
174 | begin
175 | result := TOptionalString.Create(right);
176 | end;
177 |
178 |
179 | { TOptional }
180 |
181 | function TOptional.GetValue: T;
182 | begin
183 | if fHasValue then Result := fValue
184 | else Exception.Create('no value');
185 | end;
186 |
187 | procedure TOptional.SetValue(AValue: T);
188 | begin
189 | fValue := AValue;
190 | fHasValue := True;
191 | end;
192 |
193 | procedure TOptional.Clear;
194 | begin
195 | fHasValue := False;
196 | end;
197 |
198 | { TOptionalVariant }
199 |
200 | function TOptionalVariant.GetValue: T;
201 | begin
202 | Result := T(inherited Value);
203 | end;
204 |
205 | procedure TOptionalVariant.SetValue(AValue: T);
206 | begin
207 | inherited Value := AValue;
208 | end;
209 |
210 | constructor TOptionalVariant.Create;
211 | begin
212 | inherited Create;
213 | end;
214 |
215 | constructor TOptionalVariant.Create(AValue: T);
216 | begin
217 | Create;
218 | SetValue(AValue);
219 | end;
220 |
221 | { TOptionalObject }
222 |
223 | function TOptionalObject.GetValue: T;
224 | begin
225 | Result := T(inherited Value);
226 | end;
227 |
228 | procedure TOptionalObject.SetValue(AValue: T);
229 | begin
230 | inherited Value := AValue;
231 | end;
232 |
233 | constructor TOptionalObject.Create;
234 | begin
235 | inherited Create;
236 | end;
237 |
238 | constructor TOptionalObject.Create(AValue: T);
239 | begin
240 | Create;
241 | SetValue(AValue);
242 | end;
243 |
244 | function TOptionalObject.ValueClass: TClass;
245 | begin
246 | Result := T;
247 | end;
248 |
249 | { TGenericCollection }
250 |
251 | function TGenericCollection.GetI(Index : Integer): T;
252 | begin
253 | Result:=T(Inherited Items[Index]);
254 | end;
255 |
256 | procedure TGenericCollection.SetI(Index : Integer; AValue: T);
257 | begin
258 | Inherited Items[Index]:=aValue;
259 | end;
260 |
261 | constructor TGenericCollection.Create;
262 | begin
263 | inherited Create(T);
264 | end;
265 |
266 | function TGenericCollection.Add: T;
267 | begin
268 | Result:=T(Inherited add);
269 | end;
270 |
271 | { TLSPStreamable }
272 |
273 | constructor TLSPStreamable.Create;
274 | begin
275 | Inherited Create;
276 | end;
277 |
278 | { LSPException }
279 |
280 | function EServerNotInitialized.Code: Integer;
281 | begin
282 | result := -32002;
283 | end;
284 |
285 | function EUnknownErrorCode.Code: Integer;
286 | begin
287 | result := -32001;
288 | end;
289 |
290 | function ERequestCancelled.Code: Integer;
291 | begin
292 | result := -32800;
293 | end;
294 |
295 | function EContentModified.Code: Integer;
296 | begin
297 | result := -32801;
298 | end;
299 |
300 | end.
301 |
302 |
--------------------------------------------------------------------------------
/src/protocol/LSP.CodeAction.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.CodeAction;
21 |
22 | {$mode objfpc}{$H+}
23 | {$modeswitch advancedrecords}
24 |
25 | interface
26 |
27 | uses
28 | { RTL }
29 | SysUtils, Classes,
30 | { Protocol }
31 | LSP.Base, LSP.Basic, LSP.BaseTypes;
32 |
33 | type
34 |
35 | { TCodeActionKind }
36 |
37 | { The kind of a code action.
38 | Kinds are a hierarchical list of identifiers separated by `.`, e.g. `"refactor.extract.function"`.
39 | The set of kinds is open and client needs to announce the kinds it supports to the server during
40 | initialization. }
41 |
42 | TCodeActionKind = Class
43 | public const
44 | // Empty kind.
45 | Empty = '';
46 | // Base kind for quickfix actions: 'quickfix'.
47 | QuickFix = 'quickfix';
48 | // Base kind for refactoring actions: 'refactor'.
49 | Refactor = 'refactor';
50 | // Base kind for refactoring extraction actions: 'refactor.extract'.
51 | RefactorExtract = 'refactor.extract';
52 | // Base kind for refactoring inline actions: 'refactor.inline'.
53 | RefactorInline = 'refactor.inline';
54 | // Base kind for refactoring rewrite actions: 'refactor.rewrite'.
55 | RefactorRewrite = 'refactor.rewrite';
56 | // Base kind for source actions: `source`.
57 | // Source code actions apply to the entire file.
58 | Source = 'source';
59 | // Base kind for an organize imports source action: `source.organizeImports`.
60 | SourceOrganizeImports = 'source.organizeImports';
61 | end;
62 |
63 | { TCodeAction }
64 |
65 | TCodeAction = class(TCollectionItem)
66 | private
67 | fTitle: string;
68 | fKind: String;
69 | fDiagnostics: TDiagnosticItems;
70 | fIsPreferred: boolean;
71 | fEdit: TWorkspaceEdit;
72 | fCommand: TCommand;
73 | procedure SetCommand(AValue: TCommand);
74 | procedure SetDiagnostics(AValue: TDiagnosticItems);
75 | procedure SetEdit(AValue: TWorkspaceEdit);
76 | Public
77 | constructor Create(ACollection: TCollection); override;
78 | destructor Destroy; override;
79 | published
80 | // A short, human-readable, title for this code action.
81 | property title: string read fTitle write fTitle;
82 | // The kind of the code action.
83 | // Used to filter code actions.
84 | property kind: string read fKind write fKind;
85 | // The diagnostics that this code action resolves.
86 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics;
87 | // Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted
88 | // by keybindings.
89 | //
90 | // A quick fix should be marked preferred if it properly addresses the underlying error.
91 | // A refactoring should be marked preferred if it is the most reasonable choice of actions to take.
92 | //
93 | // @since 3.15.0
94 | property isPreferred: boolean read fIsPreferred write fIsPreferred;
95 | // The workspace edit this code action performs.
96 | property edit: TWorkspaceEdit read fEdit write SetEdit;
97 | // A command this code action executes. If a code action
98 | // provides an edit and a command, first the edit is
99 | // executed and then the command.
100 | property command: TCommand read fCommand write SetCommand;
101 | end;
102 |
103 | TCodeActionItems = specialize TGenericCollection;
104 |
105 | { TCodeActionContext
106 |
107 | Contains additional diagnostic information about the context in which
108 | a code action is run. }
109 |
110 | TCodeActionContext = class(TLSPStreamable)
111 | private
112 | fDiagnostics: TDiagnosticItems;
113 | fOnly: TStrings;
114 | procedure SetDiagnostics(AValue: TDiagnosticItems);
115 | procedure SetOnly(AValue: TStrings);
116 | public
117 | Constructor Create; override;
118 | Destructor Destroy; override;
119 | Procedure Assign(Source : TPersistent); override;
120 | published
121 | // An array of diagnostics known on the client side overlapping the range provided to the
122 | // `textDocument/codeAction` request. They are provided so that the server knows which
123 | // errors are currently presented to the user for the given range. There is no guarantee
124 | // that these accurately reflect the error state of the resource. The primary parameter
125 | // to compute code actions is the provided range.
126 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics;
127 |
128 | // (OPTIONAL) Requested kind of actions to return.
129 | // Actions not of this kind are filtered out by the client before being shown. So servers
130 | // can omit computing them.
131 | property only: TStrings read fOnly write SetOnly;
132 | end;
133 |
134 | { TCodeActionParams }
135 |
136 | TCodeActionParams = class(TLSPStreamable)
137 | private
138 | fTextDocument: TTextDocumentIdentifier;
139 | fRange: TRange;
140 | fContext: TCodeActionContext;
141 | procedure SetContext(AValue: TCodeActionContext);
142 | Public
143 | constructor create; override;
144 | destructor Destroy; override;
145 | Procedure Assign(Source : TPersistent); override;
146 | published
147 | // The document in which the command was invoked.
148 | property textDocument: TTextDocumentIdentifier read fTextDocument write fTextDocument;
149 | // The range for which the command was invoked.
150 | property range: TRange read fRange write fRange;
151 | // Context carrying additional information.
152 | property context: TCodeActionContext read fContext write SetContext;
153 | end;
154 |
155 |
156 | implementation
157 |
158 | { TCodeAction }
159 |
160 | procedure TCodeAction.SetCommand(AValue: TCommand);
161 | begin
162 | if fCommand=AValue then Exit;
163 | fCommand.Assign(AValue);
164 | end;
165 |
166 | procedure TCodeAction.SetDiagnostics(AValue: TDiagnosticItems);
167 | begin
168 | if fDiagnostics=AValue then Exit;
169 | fDiagnostics.Assign(AValue);
170 | end;
171 |
172 | procedure TCodeAction.SetEdit(AValue: TWorkspaceEdit);
173 | begin
174 | if fEdit=AValue then Exit;
175 | fEdit.Assign(AValue);
176 | end;
177 |
178 | constructor TCodeAction.Create(ACollection: TCollection);
179 | begin
180 | inherited Create(ACollection);
181 | fDiagnostics:=TDiagnosticItems.Create;
182 | fEdit:=TWorkspaceEdit.Create;
183 | fCommand:=TCommand.Create;
184 | end;
185 |
186 | destructor TCodeAction.Destroy;
187 | begin
188 | FreeAndNil(fDiagnostics);
189 | FreeAndNil(fEdit);
190 | FreeAndNil(fCommand);
191 | inherited Destroy;
192 | end;
193 |
194 | { TCodeActionContext }
195 |
196 | procedure TCodeActionContext.SetDiagnostics(AValue: TDiagnosticItems);
197 | begin
198 | if fDiagnostics=AValue then Exit;
199 | fDiagnostics.Assign(AValue);
200 | end;
201 |
202 | procedure TCodeActionContext.SetOnly(AValue: TStrings);
203 | begin
204 | if fOnly=AValue then Exit;
205 | fOnly.Assign(AValue);
206 | end;
207 |
208 | constructor TCodeActionContext.Create;
209 | begin
210 | inherited Create;
211 | fDiagnostics:=TDiagnosticItems.Create;
212 | fOnly:=TStringList.Create;
213 | end;
214 |
215 | destructor TCodeActionContext.Destroy;
216 | begin
217 | FreeAndNil(fDiagnostics);
218 | FreeAndNil(fOnly);
219 | inherited Destroy;
220 | end;
221 |
222 | procedure TCodeActionContext.Assign(Source: TPersistent);
223 | var
224 | src: TCodeActionContext absolute source;
225 | begin
226 | if Source is TCodeActionContext then
227 | begin
228 | Diagnostics.Assign(Src.diagnostics);
229 | Only.Assign(Src.Only);
230 | end
231 | else
232 | inherited Assign(Source);
233 | end;
234 |
235 | { TCodeActionParams }
236 |
237 | procedure TCodeActionParams.SetContext(AValue: TCodeActionContext);
238 | begin
239 | if fContext=AValue then Exit;
240 | fContext:=AValue;
241 | end;
242 |
243 | constructor TCodeActionParams.create;
244 | begin
245 | inherited create;
246 | fTextDocument:=TTextDocumentIdentifier.Create;
247 | fRange:=TRange.Create;
248 | fContext:=TCodeActionContext.Create;
249 | end;
250 |
251 | destructor TCodeActionParams.Destroy;
252 | begin
253 | FreeAndNil(fTextDocument);
254 | FreeAndNil(fRange);
255 | FreeAndNil(fContext);
256 | inherited Destroy;
257 | end;
258 |
259 | procedure TCodeActionParams.Assign(Source: TPersistent);
260 | var
261 | Src: TCodeActionParams absolute Source;
262 | begin
263 | if Source is TCodeActionParams then
264 | begin
265 | TextDocument.Assign(Src.textDocument);
266 | Range.Assign(Src.Range);
267 | Context.Assign(Src.context);
268 | end
269 | else
270 | inherited Assign(Source);
271 | end;
272 |
273 | end.
274 |
275 |
--------------------------------------------------------------------------------
/src/protocol/LSP.Diagnostics.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.Diagnostics;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes,
29 | { Protocol }
30 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages;
31 |
32 | type
33 |
34 | { TPublishDiagnosticsParams }
35 |
36 | TPublishDiagnosticsParams = class(TLSPStreamable)
37 | private
38 | fUri: TDocumentUri;
39 | fDiagnostics: TDiagnosticItems;
40 | procedure SetDiagnostics(AValue: TDiagnosticItems);
41 | published
42 | // The URI for which diagnostic information is reported.
43 | property uri: TDocumentUri read fUri write fUri;
44 |
45 | // The version number of the document the diagnostics are published for.
46 | // todo: this must be optional
47 | //property version: integer read fVersion write fVersion;
48 |
49 | // An array of diagnostic information items.
50 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics;
51 | public
52 | Constructor Create; override;
53 | Destructor Destroy; override;
54 | end;
55 |
56 | { TPublishDiagnostics }
57 |
58 | { Diagnostics notification are sent from the server to the client to signal results of validation runs.
59 |
60 | Diagnostics are “owned” by the server so it is the server’s responsibility to clear them if necessary.
61 | The following rule is used for VS Code servers that generate diagnostics:
62 |
63 | if a language is single file only (for example HTML) then diagnostics are cleared by the server when the file is closed.
64 | if a language has a project system (for example C#) diagnostics are not cleared when a file closes. When a project is
65 | opened all diagnostics for all files are recomputed (or read from a cache).
66 | When a file changes it is the server’s responsibility to re-compute diagnostics and push them to the client. If the
67 | computed set is empty it has to push the empty array to clear former diagnostics. Newly pushed diagnostics always replace
68 | previously pushed diagnostics. There is no merging that happens on the client side. }
69 |
70 | TPublishDiagnostics = class(TNotificationMessage)
71 | private
72 | function GetDiagnosticParams: TPublishDiagnosticsParams;
73 | public
74 | constructor Create; override;
75 | destructor Destroy; override;
76 | function HaveDiagnostics : Boolean;
77 | Property DiagnosticParams : TPublishDiagnosticsParams Read GetDiagnosticParams;
78 | procedure Add(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity);
79 | procedure Clear(fileName: string);
80 | end;
81 |
82 |
83 | implementation
84 |
85 | uses SysUtils;
86 |
87 | { TPublishDiagnostics }
88 |
89 | procedure TPublishDiagnostics.Clear(fileName: string);
90 | begin
91 | DiagnosticParams.uri := PathToURI(fileName);
92 | DiagnosticParams.diagnostics.Clear;
93 | end;
94 |
95 | procedure TPublishDiagnostics.Add(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity);
96 | var
97 | Diagnostic: TDiagnostic;
98 | begin
99 | DiagnosticParams.uri := PathToURI(fileName);
100 | Diagnostic := DiagnosticParams.diagnostics.Add;
101 | Diagnostic.range.SetRange(line, column);
102 | Diagnostic.severity := severity;
103 | Diagnostic.code := code;
104 | Diagnostic.source := 'Free Pascal Compiler';
105 | Diagnostic.message := message;
106 | end;
107 |
108 | function TPublishDiagnostics.GetDiagnosticParams: TPublishDiagnosticsParams;
109 |
110 | begin
111 | Result:=Params as TPublishDiagnosticsParams;
112 | end;
113 |
114 | constructor TPublishDiagnostics.Create;
115 | begin
116 | params := TPublishDiagnosticsParams.Create;
117 | method := 'textDocument/publishDiagnostics';
118 | end;
119 |
120 | destructor TPublishDiagnostics.Destroy;
121 | begin
122 | params.Free;
123 | inherited;
124 | end;
125 |
126 | function TPublishDiagnostics.HaveDiagnostics: Boolean;
127 | begin
128 | Result:=DiagnosticParams.diagnostics.Count>0;
129 | end;
130 |
131 | { TPublishDiagnosticsParams }
132 |
133 | procedure TPublishDiagnosticsParams.SetDiagnostics(AValue: TDiagnosticItems);
134 | begin
135 | if fDiagnostics=AValue then Exit;
136 | fDiagnostics.Assign(AValue);
137 | end;
138 |
139 | constructor TPublishDiagnosticsParams.Create;
140 | begin
141 | inherited;
142 | fdiagnostics := TDiagnosticItems.Create;
143 | end;
144 |
145 | destructor TPublishDiagnosticsParams.Destroy;
146 | begin
147 | FreeAndNil(fDiagnostics);
148 | inherited Destroy;
149 | end;
150 |
151 |
152 | end.
153 |
--------------------------------------------------------------------------------
/src/protocol/LSP.DocumentHighlight.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.DocumentHighlight;
21 |
22 | {$mode objfpc}{$H+}
23 | {$scopedenums on}
24 |
25 | interface
26 | uses
27 | { RTL }
28 | SysUtils, Classes,
29 | { Protocol }
30 | LSP.Base, LSP.Basic,
31 | { Other }
32 | LSP.BaseTypes;
33 |
34 | type
35 | TDocumentHighlightKind = (
36 | __UNUSED__,
37 | Text, // A textual occurrence.
38 | Read, // Read-access of a symbol, like reading a variable.
39 | Write // Write-access of a symbol, like writing to a variable.
40 | );
41 |
42 | { TDocumentHighlight }
43 |
44 | TDocumentHighlight = class(TCollectionItem)
45 | private
46 | fRange: TRange;
47 | fKind: TDocumentHighlightKind;
48 | procedure SetRange(AValue: TRange);
49 | published
50 | // The range this highlight applies to.
51 | property range: TRange read fRange write SetRange;
52 |
53 | // The highlight kind, default is DocumentHighlightKind.Text.
54 | property kind: TDocumentHighlightKind read fKind write fKind;
55 | public
56 | constructor Create(aCollection : TCollection); override;
57 | // _range will be owned.
58 | constructor Create(aCollection : TCollection; _kind: TDocumentHighlightKind; _range: TRange);
59 | Destructor Destroy; override;
60 | end;
61 |
62 | TDocumentHighlightItems = Specialize TGenericCollection;
63 |
64 | { DocumentHighlightParams }
65 |
66 | TDocumentHighlightParams = class(TTextDocumentPositionParams)
67 | end;
68 |
69 |
70 | implementation
71 |
72 | procedure TDocumentHighlight.SetRange(AValue: TRange);
73 | begin
74 | if fRange=AValue then Exit;
75 | fRange.Assign(AValue);
76 | end;
77 |
78 | constructor TDocumentHighlight.Create(aCollection: TCollection);
79 | begin
80 | Create(aCollection,TDocumentHighlightKind.__UNUSED__,TRange.Create);
81 | end;
82 |
83 | constructor TDocumentHighlight.Create(aCollection : TCollection; _kind: TDocumentHighlightKind; _range: TRange);
84 | begin
85 | Inherited Create(aCollection);
86 | kind := _kind;
87 | FRange := _range;
88 | end;
89 |
90 | destructor TDocumentHighlight.Destroy;
91 | begin
92 | FreeAndNil(Frange);
93 | inherited Destroy;
94 | end;
95 |
96 | end.
97 |
--------------------------------------------------------------------------------
/src/protocol/LSP.ExecuteCommand.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.ExecuteCommand;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 | uses
26 | { RTL }
27 | SysUtils, Classes, FPJSON,
28 | { Protocol }
29 | LSP.Base, LSP.WorkDoneProgress;
30 |
31 | type
32 | { TExecuteCommandParams
33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#executeCommandParams
34 |
35 | The arguments are typically specified when a command is returned from the server to the client.
36 | Example requests that return a command are `textDocument/codeAction` or `textDocument/codeLens`. }
37 |
38 | TExecuteCommandParams = class(TWorkDoneProgressParams)
39 | private
40 | fCommand: String;
41 | fArguments: TJSONArray;
42 | published
43 | // The identifier of the actual command handler.
44 | property command: String read fCommand write fCommand;
45 | // Arguments that the command should be invoked with.
46 | property arguments: TJSONArray read fArguments write fArguments;
47 | public
48 | destructor Destroy; override;
49 | end;
50 |
51 |
52 | implementation
53 |
54 |
55 | destructor TExecuteCommandParams.Destroy;
56 | begin
57 | FreeAndNil(fArguments);
58 | inherited;
59 | end;
60 |
61 | end.
62 |
--------------------------------------------------------------------------------
/src/protocol/LSP.Hover.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.Hover;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes,
29 | { Protocol }
30 | LSP.BaseTypes,LSP.Base, LSP.Basic;
31 |
32 | type
33 |
34 | { THoverResponse }
35 |
36 | THoverResponse = class(TLSPStreamable)
37 | private
38 | fContents: TMarkupContent;
39 | fRange: TRange;
40 | procedure SetContents(AValue: TMarkupContent);
41 | procedure SetRange(AValue: TRange);
42 | Public
43 | Constructor Create; override;
44 | Destructor Destroy; override;
45 | published
46 | // The hover's content
47 | property contents: TMarkupContent read fContents write SetContents;
48 |
49 | // An optional range is a range inside a text document
50 | // that is used to visualize a hover, e.g. by changing the background color.
51 | property range: TRange read fRange write SetRange;
52 | end;
53 |
54 |
55 | implementation
56 |
57 | uses
58 | SysUtils;
59 |
60 | { THoverResponse }
61 |
62 | procedure THoverResponse.SetContents(AValue: TMarkupContent);
63 | begin
64 | if fContents=AValue then Exit;
65 | fContents.Assign(AValue);
66 | end;
67 |
68 | procedure THoverResponse.SetRange(AValue: TRange);
69 | begin
70 | if fRange=AValue then Exit;
71 | fRange.Assign(AValue);
72 | end;
73 |
74 | constructor THoverResponse.Create;
75 | begin
76 | inherited Create;
77 | fContents:=TMarkupContent.Create;
78 | fRange:=TRange.Create;
79 | end;
80 |
81 | destructor THoverResponse.Destroy;
82 | begin
83 | FreeAndNil(fContents);
84 | FreeAndNil(fRange);
85 | inherited Destroy;
86 | end;
87 |
88 | { THoverRequest }
89 | end.
90 |
91 |
--------------------------------------------------------------------------------
/src/protocol/LSP.InlayHint.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.InlayHint;
21 |
22 | {$mode objfpc}{$H+}
23 | {$scopedenums on}
24 |
25 | interface
26 |
27 | uses
28 | { RTL }
29 | Classes, SysUtils,
30 | { LSP Protocol }
31 | LSP.Base, LSP.Basic, LSP.BaseTypes;
32 |
33 | type
34 |
35 | { TInlayHintKind }
36 | TInlayHintKind = (
37 | // TODO: do we need this for optionals?
38 | __UNUSED__,
39 | _Type, // An inlay hint that for a type annotation.
40 | Parameter // An inlay hint that is for a parameter.
41 | );
42 |
43 | TOptionalInlayHintKind = specialize TOptional;
44 |
45 | { TInlayHint
46 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#inlayHint
47 |
48 | Inlay hint information. }
49 |
50 | TInlayHint = class(TCollectionItem)
51 | private
52 | fPosition: TPosition;
53 | fLabel: String; // string | InlayHintLabelPart[] (not supported now)
54 | fKind: TOptionalInlayHintKind;
55 | fTextEdits: TTextEdits;
56 | fTooltip: String;
57 | public
58 | Constructor Create(ACollection: TCollection); override;
59 | published
60 | // The position of this hint.
61 | property position: TPosition read fPosition write fPosition;
62 | // The label of this hint. A human readable string or an array of
63 | // InlayHintLabelPart label parts.
64 | //
65 | // *Note* that neither the string nor the label part can be empty.
66 | property &label: String read fLabel write fLabel;
67 | // The kind of this hint. Can be omitted in which case the client
68 | // should fall back to a reasonable default.
69 | // owned by the inlayhint
70 | property kind: TOptionalInlayHintKind read fKind write fKind;
71 | // Optional text edits that are performed when accepting this inlay hint.
72 | //
73 | // *Note* that edits are expected to change the document so that the inlay
74 | // hint (or its nearest variant) is now part of the document and the inlay
75 | // hint itself is now obsolete.
76 | //
77 | // Depending on the client capability `inlayHint.resolveSupport` clients
78 | // might resolve this property late using the resolve request.
79 | property textEdits: TTextEdits read fTextEdits write fTextEdits;
80 | // The tooltip text when you hover over this item.
81 | //
82 | // Depending on the client capability `inlayHint.resolveSupport` clients
83 | // might resolve this property late using the resolve request.
84 | property tooltip: String read fTooltip write fTooltip;
85 | public
86 | destructor Destroy; override;
87 | end;
88 |
89 | TInlayHints = specialize TGenericCollection;
90 |
91 | { TInlayHintParams
92 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#inlayHintParams
93 |
94 | A parameter literal used in inlay hint requests. }
95 |
96 | TInlayHintParams = class(TLSPStreamable)
97 | private
98 | fTextDocument: TTextDocumentIdentifier;
99 | fRange: TRange;
100 | procedure SetRange(AValue: TRange);
101 | procedure SetTextDocument(AValue: TTextDocumentIdentifier);
102 | published
103 | // The text document.
104 | property textDocument: TTextDocumentIdentifier read fTextDocument write SetTextDocument;
105 | // The visible document range for which inlay hints should be computed.
106 | property range: TRange read fRange write SetRange;
107 | public
108 | constructor create; override;
109 | destructor Destroy; override;
110 | end;
111 |
112 | implementation
113 |
114 | { TInlayHint }
115 |
116 | constructor TInlayHint.Create(ACollection: TCollection);
117 | begin
118 | inherited Create(ACollection);
119 | fPosition:=TPosition.Create;
120 | fTextEdits:=TTextEdits.Create;
121 | end;
122 |
123 | destructor TInlayHint.Destroy;
124 | begin
125 | FreeAndNil(fPosition);
126 | FreeAndNil(fKind);
127 | FreeAndNil(fTextEdits);
128 | inherited;
129 | end;
130 |
131 | { TInlayHintParams }
132 |
133 | procedure TInlayHintParams.SetRange(AValue: TRange);
134 | begin
135 | if fRange=AValue then Exit;
136 | fRange.Assign(AValue);
137 | end;
138 |
139 | procedure TInlayHintParams.SetTextDocument(AValue: TTextDocumentIdentifier);
140 | begin
141 | if fTextDocument=AValue then Exit;
142 | fTextDocument.Assign(AValue);
143 | end;
144 |
145 | constructor TInlayHintParams.create;
146 | begin
147 | inherited create;
148 | ftextDocument:=TTextDocumentIdentifier.Create;
149 | frange:=TRange.Create;
150 | end;
151 |
152 | destructor TInlayHintParams.Destroy;
153 | begin
154 | FreeAndNil(fTextDocument);
155 | FreeAndNil(fRange);
156 | inherited;
157 | end;
158 |
159 | end.
160 |
--------------------------------------------------------------------------------
/src/protocol/LSP.Messages.pas:
--------------------------------------------------------------------------------
1 | // Copyright 2023 Michael Van Canneyt
2 | // This file is part of Pascal Language Server.
3 |
4 | // Pascal Language Server is free software: you can redistribute it
5 | // and/or modify it under the terms of the GNU General Public License
6 | // as published by the Free Software Foundation, either version 3 of
7 | // the License, or (at your option) any later version.
8 |
9 | // Pascal Language Server is distributed in the hope that it will be
10 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
11 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 | // GNU General Public License for more details.
13 |
14 | // You should have received a copy of the GNU General Public License
15 | // along with Pascal Language Server. If not, see
16 | // .
17 |
18 | unit LSP.Messages;
19 |
20 | {$mode objfpc}{$H+}
21 |
22 | interface
23 |
24 | uses
25 | Classes, SysUtils, LSP.Streaming, fpJSON, LSP.BaseTypes;
26 |
27 | Type
28 | // We cannot assume stdout to send out-of-band messages.
29 |
30 | { TMessageTransport }
31 | TMessageLog = procedure(sender : TObject; Const Msg : UTF8String) of object;
32 |
33 | TMessageTransport = class
34 | Protected
35 | Procedure DoSendMessage(aMessage : TJSONData); virtual; abstract;
36 | Procedure DoSendDiagnostic(const aMessage : UTF8String); virtual; abstract;
37 | Procedure DoLog(Const Msg : UTF8String); overload;
38 | Procedure DoLog(Const Fmt : UTF8String; Const args : array of const); overload;
39 | Public
40 | Class Var OnLog : TMessageLog;
41 | Public
42 | Procedure SendMessage(aMessage : TJSONData);
43 | Procedure SendDiagnostic(const aMessage : UTF8String);
44 | Procedure SendDiagnostic(const Fmt : String; const args : Array of const); overload;
45 | end;
46 |
47 | { TAbstractMessage
48 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#abstractMessage
49 |
50 | A general message as defined by JSON-RPC. The language server
51 | protocol always uses “2.0” as the jsonrpc version. }
52 |
53 | TAbstractMessage = class(TLSPStreamable)
54 | private
55 | function GetJSONRPC: String;
56 | published
57 | property jsonrpc: String read GetJSONRPC;
58 | public
59 | procedure Send(aTransport : TMessageTransport);
60 | end;
61 |
62 | { TRequestMessage
63 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#requestMessage
64 |
65 | A request message to describe a request between the client and the server.
66 | Every processed request must send a response back to the sender of the request. }
67 |
68 | TRequestMessage = class(TAbstractMessage)
69 | protected
70 | fID: TOptionalAny; // integer | string
71 | fMethod: string;
72 | fParams: TLSPStreamable;
73 | published
74 | // The request id.
75 | property id: TOptionalAny read fID write fID;
76 | // The method to be invoked.
77 | property method: string read fMethod write fMethod;
78 | // The notification's params. Not freed when message is freed.
79 | property params: TLSPStreamable read fParams write fParams;
80 | end;
81 |
82 | { TNotificationMessage
83 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#notificationMessage
84 |
85 | A notification message. A processed notification message
86 | must not send a response back. They work like events. }
87 |
88 | TNotificationMessage = class(TAbstractMessage)
89 | protected
90 | fMethod: string;
91 | fParams: TLSPStreamable;
92 | published
93 | // The method to be invoked.
94 | property method: string read fMethod write fMethod;
95 | // The notification's params.
96 | property params: TLSPStreamable read fParams write fParams;
97 | end;
98 |
99 |
100 |
101 | const
102 | ContentType = 'application/vscode-jsonrpc; charset=utf-8';
103 |
104 |
105 | implementation
106 |
107 | { TMessageTransport }
108 |
109 | procedure TMessageTransport.DoLog(const Msg: UTF8String);
110 | begin
111 | If Assigned(OnLog) then
112 | OnLog(Self,Msg);
113 | end;
114 |
115 | procedure TMessageTransport.DoLog(const Fmt: UTF8String;
116 | const args: array of const);
117 | begin
118 | DoLog(Format(Fmt,Args));
119 | end;
120 |
121 | procedure TMessageTransport.SendMessage(aMessage: TJSONData);
122 | begin
123 | DoLog('Sending message: %s',[aMessage.AsJSON]);
124 | DoSendMessage(aMessage);
125 | end;
126 |
127 | procedure TMessageTransport.SendDiagnostic(const aMessage: UTF8String);
128 | begin
129 | DoLog('Sending diagnostic: %s',[aMessage]);
130 | DoSendDiagnostic(aMessage);
131 | end;
132 |
133 | procedure TMessageTransport.SendDiagnostic(const Fmt: String;
134 | const args: array of const);
135 | begin
136 | SendDiagnostic(Format(Fmt,Args));
137 | end;
138 |
139 | { TAbstractMessage }
140 |
141 | function TAbstractMessage.GetJSONRPC: String;
142 | begin
143 | result := '2.0';
144 | end;
145 |
146 | procedure TAbstractMessage.Send(aTransport : TMessageTransport);
147 | var
148 | Data: TJSONData;
149 |
150 | begin
151 | Data := specialize
152 | TLSPStreaming.ToJSON(self);
153 | if Data <> nil then
154 | begin
155 | aTransport.SendMessage(Data);
156 | Data.Free;
157 | end;
158 | end;
159 |
160 |
161 | end.
162 |
163 |
--------------------------------------------------------------------------------
/src/protocol/LSP.References.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.References;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | SysUtils, Classes,
29 | { Protocol }
30 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages;
31 |
32 | type
33 |
34 | { TReferenceContext }
35 |
36 | TReferenceContext = class(TLSPStreamable)
37 | private
38 | fIncludeDeclaration: boolean;
39 | published
40 | // Include the declaration of the current symbol.
41 | property includeDeclaration: boolean read fIncludeDeclaration write fIncludeDeclaration;
42 | end;
43 |
44 | { TReferenceParams }
45 |
46 | TReferenceParams = class(TTextDocumentPositionParams)
47 | private
48 | fContext: TReferenceContext;
49 | procedure SetContext(AValue: TReferenceContext);
50 | public
51 | Constructor Create; override;
52 | Destructor Destroy; override;
53 | Procedure Assign(Source: TPersistent); override;
54 | published
55 | property context: TReferenceContext read fContext write SetContext;
56 | end;
57 |
58 |
59 |
60 | implementation
61 |
62 |
63 | { TReferenceParams }
64 |
65 | procedure TReferenceParams.SetContext(AValue: TReferenceContext);
66 | begin
67 | if fContext=AValue then Exit;
68 | fContext.Assign(AValue);
69 | end;
70 |
71 | constructor TReferenceParams.Create;
72 | begin
73 | inherited Create;
74 | fContext:=TReferenceContext.Create;
75 | end;
76 |
77 | destructor TReferenceParams.Destroy;
78 | begin
79 | FreeAndNil(fContext);
80 | inherited Destroy;
81 | end;
82 |
83 | procedure TReferenceParams.Assign(Source: TPersistent);
84 | var
85 | Src: TReferenceParams absolute Source;
86 | begin
87 | if Source is TReferenceParams then
88 | begin
89 | Context.Assign(Src.context);
90 | end
91 | else
92 | inherited Assign(Source);
93 | end;
94 |
95 | end.
96 |
97 |
--------------------------------------------------------------------------------
/src/protocol/LSP.SignatureHelp.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.SignatureHelp;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes,
29 | { Protocol }
30 | LSP.Base, LSP.Basic, LSP.BaseTypes;
31 |
32 | type
33 |
34 | { TParameterInformation }
35 |
36 | { Represents a parameter of a callable-signature. A parameter can
37 | have a label and a doc-comment. }
38 |
39 | TParameterInformation = class(TCollectionItem)
40 | private
41 | fLabel: string;
42 | fDocumentation: TMarkupContent;
43 | procedure SetDocumentation(AValue: TMarkupContent);
44 | Public
45 | Constructor Create(ACollection: TCollection); override;
46 | Destructor Destroy; override;
47 | Procedure Assign(Source: TPersistent); override;
48 | published
49 | // The label of this parameter information.
50 | //
51 | // Either a string or an inclusive start and exclusive end offsets within its containing
52 | // signature label. (see SignatureInformation.label). The offsets are based on a UTF-16
53 | // string representation as `Position` and `Range` does.
54 | //
55 | // *Note*: a label of type string should be a substring of its containing signature label.
56 | // Its intended use case is to highlight the parameter label part in the `SignatureInformation.label`.
57 | property &label: string read fLabel write fLabel;
58 |
59 | // The human-readable doc-comment of this parameter. Will be shown
60 | // in the UI but can be omitted.
61 | property documentation: TMarkupContent read fDocumentation write SetDocumentation;
62 | end;
63 |
64 | TParameterInformationCollection = specialize TGenericCollection;
65 |
66 | { TSignatureInformation }
67 |
68 | { Represents the signature of something callable. A signature
69 | can have a label, like a function-name, a doc-comment, and
70 | a set of parameters. }
71 |
72 | TSignatureInformation = class(TCollectionItem)
73 | private
74 | fLabel: string;
75 | fDocumentation: TMarkupContent;
76 | fParameters: TParameterInformationCollection;
77 | procedure SetDocumentation(AValue: TMarkupContent);
78 | procedure SetParameters(AValue: TParameterInformationCollection);
79 | Public
80 | Constructor Create(ACollection: TCollection); override;
81 | destructor Destroy; override;
82 | published
83 | // The label of this signature. Will be shown in
84 | // the UI.
85 | property &label: string read fLabel write fLabel;
86 |
87 | // The human-readable doc-comment of this signature. Will be shown
88 | // in the UI but can be omitted.
89 | property documentation: TMarkupContent read fDocumentation write SetDocumentation;
90 |
91 | // The parameters of this signature.
92 | property parameters: TParameterInformationCollection read fParameters write SetParameters;
93 | end;
94 |
95 | TSignatureInformationCollection = specialize TGenericCollection;
96 |
97 | { TSignatureHelp
98 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#signatureHelp
99 |
100 | Signature help represents the signature of something callable.
101 | There can be multiple signature but only one active and only one active parameter. }
102 |
103 | TSignatureHelp = class(TLSPStreamable)
104 | private
105 | fSignatures: TSignatureInformationCollection;
106 | fActiveSignature: integer;
107 | fActiveParameter: integer;
108 | procedure SetSignatures(AValue: TSignatureInformationCollection);
109 | Public
110 | Constructor Create; override;
111 | Destructor Destroy; override;
112 | published
113 | // One or more signatures.
114 | property signatures: TSignatureInformationCollection read fSignatures write SetSignatures;
115 |
116 | // The active signature. If omitted or the value lies outside the
117 | // range of `signatures` the value defaults to zero or is ignored if
118 | // `signatures.length === 0`. Whenever possible implementors should
119 | // make an active decision about the active signature and shouldn't
120 | // rely on a default value.
121 | // In future version of the protocol this property might become
122 | // mandatory to better express this.
123 | property activeSignature: integer read fActiveSignature write fActiveSignature;
124 |
125 | // The active parameter of the active signature. If omitted or the value
126 | // lies outside the range of `signatures[activeSignature].parameters`
127 | // defaults to 0 if the active signature has parameters. If
128 | // the active signature has no parameters it is ignored.
129 | // In future version of the protocol this property might become
130 | // mandatory to better express the active parameter if the
131 | // active signature does have any.
132 | property activeParameter: integer read fActiveParameter write fActiveParameter;
133 |
134 | end;
135 |
136 |
137 | implementation
138 |
139 | uses
140 | { RTL }
141 | SysUtils;
142 |
143 | { TParameterInformation }
144 |
145 | procedure TParameterInformation.SetDocumentation(AValue: TMarkupContent);
146 | begin
147 | if fDocumentation=AValue then Exit;
148 | fDocumentation.Assign(AValue);
149 | end;
150 |
151 | constructor TParameterInformation.Create(ACollection: TCollection);
152 | begin
153 | inherited Create(ACollection);
154 | fDocumentation:=TMarkupContent.Create;
155 | end;
156 |
157 | destructor TParameterInformation.Destroy;
158 | begin
159 | FreeAndNil(fDocumentation);
160 | Inherited;
161 | end;
162 |
163 | procedure TParameterInformation.Assign(Source: TPersistent);
164 | var
165 | Src: TParameterInformation absolute Source;
166 | begin
167 | if Source is TParameterInformation then
168 | begin
169 | fLabel:=Src.fLabel;
170 | Documentation.Assign(Src.documentation);
171 | end
172 | else
173 | inherited Assign(Source);
174 | end;
175 |
176 | { TSignatureInformation }
177 |
178 | procedure TSignatureInformation.SetDocumentation(AValue: TMarkupContent);
179 | begin
180 | if fDocumentation=AValue then Exit;
181 | fDocumentation.Assign(AValue);
182 | end;
183 |
184 | procedure TSignatureInformation.SetParameters(
185 | AValue: TParameterInformationCollection);
186 | begin
187 | if fParameters=AValue then Exit;
188 | fParameters.Assign(AValue);
189 | end;
190 |
191 | constructor TSignatureInformation.Create(ACollection: TCollection);
192 | begin
193 | inherited Create(ACollection);
194 | fDocumentation:=TMarkupContent.Create;
195 | fParameters:=TParameterInformationCollection.Create;
196 | end;
197 |
198 | destructor TSignatureInformation.Destroy;
199 | begin
200 | FreeAndNil(fDocumentation);
201 | FreeAndNil(fParameters);
202 | inherited Destroy;
203 | end;
204 |
205 | { TSignatureHelp }
206 |
207 | procedure TSignatureHelp.SetSignatures(AValue: TSignatureInformationCollection);
208 | begin
209 | if fSignatures=AValue then Exit;
210 | fSignatures.Assign(AValue);
211 | end;
212 |
213 | constructor TSignatureHelp.Create;
214 | begin
215 | inherited Create;
216 | fSignatures:=TSignatureInformationCollection.Create;
217 | end;
218 |
219 | destructor TSignatureHelp.Destroy;
220 | begin
221 | FreeAndNil(fSignatures);
222 | inherited Destroy;
223 | end;
224 |
225 | end.
226 |
227 |
--------------------------------------------------------------------------------
/src/protocol/LSP.Window.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.Window;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | SysUtils, Classes,
29 | { Protocol }
30 | LSP.Base, LSP.BaseTypes, LSP.Messages;
31 |
32 | type
33 |
34 | { TMessageType }
35 |
36 | TMessageType = (
37 | __UNUSED__,
38 | Error, // An error message.
39 | Warning, // A warning message.
40 | Info, // An information message.
41 | Log // A log message.
42 | );
43 |
44 | { TShowMessageParams }
45 |
46 | TShowMessageParams = class(TLSPStreamable)
47 | private
48 | fType: TMessageType;
49 | fMessage: string;
50 | Public
51 | Procedure Assign(Source: TPersistent); override;
52 | published
53 | // The message type.
54 | property &type: TMessageType read fType write fType;
55 | // The actual message.
56 | property message: string read fMessage write fMessage;
57 | end;
58 |
59 | { TShowMessageNotification
60 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#window_showMessage
61 |
62 | The show message notification is sent from a server to a client to ask
63 | the client to display a particular message in the user interface. }
64 |
65 | TShowMessageNotification = class(TNotificationMessage)
66 | public
67 | constructor Create; override;
68 | constructor Create(_type: TMessageType; Message: String);
69 | destructor Destroy; override;
70 | end;
71 |
72 | TMessageActionItem = class(TCollectionItem)
73 | private
74 | fTitle: string;
75 | published
76 | // A short title like 'Retry', 'Open Log' etc.
77 | property title: string read fTitle write fTitle;
78 | end;
79 |
80 | TMessageActionItems = specialize TGenericCollection;
81 |
82 | { TShowMessageRequestParams }
83 |
84 | TShowMessageRequestParams = class(TShowMessageParams)
85 | private
86 | fActions: TMessageActionItems;
87 | procedure SetActions(AValue: TMessageActionItems);
88 | public
89 | Constructor Create; override;
90 | Destructor Destroy; override;
91 | // The message action items to present.
92 | property actions: TMessageActionItems read fActions write SetActions;
93 | end;
94 |
95 | implementation
96 |
97 | { TShowMessageParams }
98 |
99 | procedure TShowMessageParams.Assign(Source: TPersistent);
100 | Var
101 | Src: TShowMessageParams absolute Source;
102 | begin
103 | if Source is TShowMessageParams then
104 | begin
105 | fType:= Src.fType;
106 | fMessage:= Src.fMessage;
107 | end
108 | else
109 | inherited Assign(Source);
110 | end;
111 |
112 | { TShowMessageNotification }
113 |
114 | constructor TShowMessageNotification.Create;
115 | begin
116 | inherited Create;
117 | params := TShowMessageParams.Create;
118 | end;
119 |
120 | constructor TShowMessageNotification.Create(_type: TMessageType; Message: String);
121 | begin
122 | Create;
123 | TShowMessageParams(params).&type := _type;
124 | TShowMessageParams(params).message := Message;
125 | method := 'window/showMessage';
126 | end;
127 |
128 | destructor TShowMessageNotification.Destroy;
129 | begin
130 | params.Free;
131 | inherited;
132 | end;
133 |
134 | { TShowMessageRequstParams }
135 |
136 | procedure TShowMessageRequestParams.SetActions(AValue: TMessageActionItems);
137 | begin
138 | if fActions=AValue then Exit;
139 | fActions.Assign(AValue);
140 | end;
141 |
142 | constructor TShowMessageRequestParams.Create;
143 | begin
144 | inherited Create;
145 | fActions:=TMessageActionItems.Create;
146 | end;
147 |
148 | destructor TShowMessageRequestParams.Destroy;
149 | begin
150 | FreeAndNil(fActions);
151 | inherited Destroy;
152 | end;
153 |
154 | end.
155 |
--------------------------------------------------------------------------------
/src/protocol/LSP.WorkDoneProgress.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit LSP.WorkDoneProgress;
21 |
22 | {$mode objfpc}{$H+}
23 | {$scopedenums on}
24 |
25 | interface
26 | uses
27 | { RTL }
28 | Classes, LSP.BaseTypes;
29 |
30 | type
31 | TProgressToken = String; { integer | string }
32 |
33 | type
34 | TWorkDoneProgressParams = class(TLSPStreamable)
35 | private
36 | fWorkDoneToken: TProgressToken;
37 | published
38 | // An optional token that a server can use to report work done progress.
39 | property workDoneToken: TProgressToken read fWorkDoneToken write fWorkDoneToken;
40 | end;
41 |
42 | implementation
43 |
44 | end.
45 |
--------------------------------------------------------------------------------
/src/protocol/PasLS.TextLoop.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // LSP Text/File based protocol - in particular, Standard Input/Output/Error files.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.TextLoop;
21 |
22 | {$mode ObjFPC}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | Classes, SysUtils, LSP.Base, LSP.Messages, fpjson;
28 |
29 | Type
30 |
31 | { TTextLSPContext }
32 | PText = ^Text;
33 |
34 | { TLSPTextTransport }
35 |
36 | TLSPTextTransport = class(TMessageTransport)
37 | FOutput : PText;
38 | FError : PText;
39 | Protected
40 | Procedure DoSendMessage(aMessage: TJSONData); override;
41 | Procedure DoSendDiagnostic(const aMessage: UTF8String); override;
42 | Public
43 | constructor Create(aOutput,aError : PText); reintroduce;
44 | Procedure EmitMessage(aMessage: TJSONStringType);
45 | end;
46 |
47 |
48 |
49 | Procedure SetupTextLoop(var aInput,aOutput,aError : Text);
50 | Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext);
51 | procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String);
52 |
53 | implementation
54 |
55 | Procedure SetupTextLoop(var aInput,aOutput,aError : Text);
56 |
57 | begin
58 | TJSONData.CompressedJSON := True;
59 | SetTextLineEnding(aInput, #13#10);
60 | SetTextLineEnding(aOutput, #13#10);
61 | SetTextLineEnding(aError, #13#10);
62 | end;
63 |
64 |
65 | procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String);
66 |
67 | var
68 | Content: TJSONStringType;
69 | Request: TJSONData;
70 | Response: TJSONData;
71 |
72 | begin
73 | Response:=Nil;
74 | Writeln(aFile,'▶️ ', aMethod);
75 | Content := '{"jsonrpc": "2.0","id": '+aContext.NextMessageID.ToString+', "method": "'+aMethod+'","params": '+aParams+'}';
76 | Request := GetJSON(Content, True);
77 | try
78 | Response := aContext.Execute(Request);
79 | if Assigned(Response) then
80 | begin
81 | writeln(aFile,'◀️ response: ');
82 | writeln(aFile,Response.FormatJSON);
83 | Flush(aFile);
84 | end;
85 | finally
86 | Request.Free;
87 | Response.Free;
88 | end;
89 | end;
90 |
91 |
92 |
93 | Function ReadRequest(var aFile : text; aContext : TLSPContext) : TJSONData;
94 |
95 | Var
96 | Header,Name,Value: String;
97 | Content : TJSONStringType;
98 | I,ContentLength : Integer;
99 | P : PJSONCharType;
100 |
101 | begin
102 | Result:=Nil;
103 | aContext.Log('Reading request');
104 | ReadLn(aFile,Header);
105 | while Header <> '' do
106 | begin
107 | aContext.Log('Read header: %s',[Header]);
108 | I := Pos(':', Header);
109 | Name := Copy(Header, 1, I - 1);
110 | Delete(Header, 1, i);
111 | Value := Trim(Header);
112 | if Name = 'Content-Length' then
113 | ContentLength := StrToIntDef(Value,0);
114 | ReadLn(aFile,Header);
115 | end;
116 | Content:='';
117 | SetLength(Content,ContentLength);
118 | P:=PJSONCharType(Content);
119 | for I:=1 to ContentLength do
120 | begin
121 | Read(aFile,P^);
122 | inc(P);
123 | end;
124 | if Content<>'' then
125 | Result:=GetJSON(Content, True);
126 | end;
127 |
128 | Procedure SendResponse(aTransport : TMessageTransport; aContext : TLSPContext; aResponse : TJSONData; aFreeResponse : Boolean = True);
129 |
130 | Var
131 | Content : TJSONStringType;
132 |
133 | begin
134 | try
135 | if not IsResponseValid(aResponse) then
136 | begin
137 | aContext.Log('Response not valid: %s',[aResponse.AsJSON]);
138 | aTransport.SendDiagnostic('invalid response -> '+aResponse.AsJSON);
139 | exit;
140 | end;
141 | Content := aResponse.AsJSON;
142 | (aTransport as TLSPTextTransport).EmitMessage(Content);
143 | aContext.Log('Wrote response to request');
144 | finally
145 | if aFreeResponse then
146 | aResponse.Free;
147 | end;
148 | end;
149 |
150 | Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext);
151 |
152 | var
153 | Request, Response: TJSONData;
154 | VerboseDebugging: boolean = false;
155 | IO : TLSPTextTransport;
156 |
157 | begin
158 | IO:=Nil;
159 | Request:=Nil;
160 | try
161 | if aContext.Transport is TLSPTextTransport then
162 | IO:=aContext.Transport as TLSPTextTransport
163 | else
164 | IO:=TLSPTextTransport.Create(@aOutput,@aError);
165 | while not EOF(aInput) do
166 | begin
167 | Request:=ReadRequest(aInput,aContext);
168 | // log request payload
169 | if VerboseDebugging then
170 | begin
171 | Writeln(aError, Request.FormatJSON);
172 | Flush(aError);
173 | end;
174 | Response := aContext.Execute(Request);
175 | if Assigned(Response) then
176 | begin
177 | // log response payload
178 | if VerboseDebugging then
179 | begin
180 | writeln(aError, Response.asJSON);
181 | Flush(aError);
182 | end;
183 | SendResponse(IO, aContext, Response,True);
184 | end
185 | else
186 | aContext.Log('No response to request');
187 | FreeAndNil(Request);
188 | end;
189 | finally
190 | if IO<>aContext.Transport then
191 | IO.Free;
192 | Request.Free;
193 | end;
194 | end;
195 |
196 | { TTextLSPContext }
197 |
198 | constructor TLSPTextTransport.Create(aOutput, aError: PText);
199 | begin
200 | FOutput:=aOutput;
201 | FError:=aError;
202 | end;
203 |
204 | procedure TLSPTextTransport.EmitMessage(aMessage: TJSONStringType);
205 | begin
206 | Try
207 | WriteLn(Foutput^,'Content-Type: ', ContentType);
208 | WriteLn(Foutput^,'Content-Length: ', Length(aMessage));
209 | WriteLn(Foutput^);
210 | Write(Foutput^,aMessage);
211 | Flush(Foutput^);
212 | except
213 | on e : exception do
214 | DoLog('Exception %s during output: %s',[E.ClassName,E.Message]);
215 | end;
216 | end;
217 |
218 | procedure TLSPTextTransport.DoSendMessage(aMessage: TJSONData);
219 |
220 | Var
221 | Content : TJSONStringType;
222 |
223 | begin
224 | Content:=aMessage.AsJSON;
225 | EmitMessage(Content);
226 | end;
227 |
228 | procedure TLSPTextTransport.DoSendDiagnostic(const aMessage: UTF8String);
229 | begin
230 | Try
231 | WriteLn(FError^,aMessage);
232 | Flush(FError^);
233 | except
234 | on e : exception do
235 | DoLog('Exception %s during diagnostic output: %s',[E.ClassName,E.Message]);
236 | end;
237 | end;
238 |
239 |
240 |
241 | end.
242 |
243 |
--------------------------------------------------------------------------------
/src/protocol/lspprotocol.lpk:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/protocol/lspprotocol.pas:
--------------------------------------------------------------------------------
1 | { This file was automatically created by Lazarus. Do not edit!
2 | This source is only used to compile and install the package.
3 | }
4 |
5 | unit lspprotocol;
6 |
7 | {$warn 5023 off : no warning about unused units}
8 | interface
9 |
10 | uses
11 | LSP.CodeAction, LSP.Diagnostics, LSP.DocumentHighlight, LSP.DocumentSymbol,
12 | LSP.ExecuteCommand, LSP.Hover, LSP.InlayHint, LSP.Basic, LSP.Capabilities,
13 | LSP.Completion, LSP.General, LSP.Base, LSP.Options, LSP.References,
14 | LSP.SignatureHelp, LSP.Synchronization, LSP.Window, LSP.WorkDoneProgress,
15 | LSP.Workspace, PasLS.TextLoop, PasLS.SocketDispatcher, LSP.Streaming,
16 | LSP.BaseTypes, LSP.Messages, LazarusPackageIntf;
17 |
18 | implementation
19 |
20 | procedure Register;
21 | begin
22 | end;
23 |
24 | initialization
25 | RegisterPackage('lspprotocol', @Register);
26 | end.
27 |
--------------------------------------------------------------------------------
/src/protocol/memutils.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | {$mode objfpc}
21 | {$modeswitch autoderef}
22 |
23 | unit MemUtils;
24 | interface
25 | uses
26 | Math, Types, SysUtils, FGL;
27 |
28 | type
29 | TAutoRetainHelpers = class helper for TObject
30 | constructor Instance;
31 | function Retain: TObject;
32 | function Release: TObject;
33 | function AutoRelease: TObject;
34 | end;
35 |
36 | procedure ReleaseAndNil(var obj: TObject);
37 | procedure DrainAutoReleasePool;
38 |
39 | implementation
40 |
41 | type
42 |
43 | { TAutoReleasePool }
44 |
45 | TAutoReleasePool = class(specialize TFPGList)
46 | constructor Create;
47 | destructor Destroy; override;
48 | procedure Drain;
49 | end;
50 |
51 | { TAutoWrapper }
52 |
53 | TAutoWrapper = record
54 | obj: TObject;
55 | refCount: integer;
56 | end;
57 | PAutoWrapper = ^TAutoWrapper;
58 | TAutoWrapperMap = specialize TFPGMap;
59 |
60 | { TAutoWrapperMapHelper }
61 |
62 | TAutoWrapperMapHelper = class helper for TAutoWrapperMap
63 | function GetRef(const key: SizeUInt): PAutoWrapper; inline;
64 | end;
65 |
66 | TAutoReleasePoolList = specialize TFPGList;
67 |
68 | var
69 | AutoRetainMap: TAutoWrapperMap;
70 | AutoReleaseStack: TAutoReleasePoolList;
71 |
72 | {*****************************************************************************
73 | * Functions
74 | *****************************************************************************}
75 |
76 | procedure ReleaseAndNil(var obj: TObject);
77 | begin
78 | if assigned(obj) then
79 | begin
80 | obj.Release;
81 | obj := nil;
82 | end;
83 | end;
84 |
85 | procedure DrainAutoReleasePool;
86 | var
87 | obj: TObject;
88 | begin
89 | for obj in AutoReleaseStack.Last do
90 | obj.Release;
91 | AutoReleaseStack.Last.Clear;
92 | end;
93 |
94 | {*****************************************************************************
95 | * TAutoReleasePool
96 | *****************************************************************************}
97 |
98 | procedure TAutoReleasePool.Drain;
99 | var
100 | obj: TObject;
101 | begin
102 | for obj in self do
103 | obj.Release;
104 | Clear;
105 | end;
106 |
107 | destructor TAutoReleasePool.Destroy;
108 | begin
109 | Drain;
110 | AutoReleaseStack.Delete(AutoReleaseStack.Count - 1);
111 | inherited;
112 | end;
113 |
114 | constructor TAutoReleasePool.Create;
115 | begin
116 | AutoReleaseStack.Add(self);
117 | inherited;
118 | end;
119 |
120 | {*****************************************************************************
121 | * TAutoWrapperMapHelper
122 | *****************************************************************************}
123 |
124 | function TAutoWrapperMapHelper.GetRef(const key: SizeUInt): PAutoWrapper;
125 | begin
126 | result := TFPSMap(self).KeyData[@key];
127 | end;
128 |
129 | {*****************************************************************************
130 | * TAutoRetainHelpers
131 | *****************************************************************************}
132 |
133 | constructor TAutoRetainHelpers.Instance;
134 | begin
135 | NewInstance;
136 | AfterConstruction;
137 | AutoRelease;
138 | end;
139 |
140 | function TAutoRetainHelpers.AutoRelease: TObject;
141 | begin
142 | Assert(AutoReleaseStack.Count > 0, 'No auto release pools are open!');
143 | // retain and then add to open pool
144 | AutoReleaseStack.Last.Add(Retain);
145 | result := self;
146 | end;
147 |
148 | function TAutoRetainHelpers.Retain: TObject;
149 | var
150 | wrapper: TAutoWrapper;
151 | ref: PAutoWrapper;
152 | key: SizeUInt;
153 | begin
154 | key := SizeUInt(self);
155 | if not AutoRetainMap.TryGetData(key, wrapper) then
156 | begin
157 | wrapper.obj := self;
158 | wrapper.refCount := 1;
159 | AutoRetainMap[key] := wrapper;
160 | end
161 | else
162 | begin
163 | ref := AutoRetainMap.GetRef(key);
164 | ref.refCount += 1;
165 | end;
166 | result := self;
167 | end;
168 |
169 | function TAutoRetainHelpers.Release: TObject;
170 | var
171 | wrapper: PAutoWrapper;
172 | begin
173 | wrapper := AutoRetainMap.GetRef(SizeUInt(self));
174 | dec(wrapper.refCount);
175 | if wrapper.refCount = 0 then
176 | begin
177 | wrapper.obj.Free;
178 | AutoRetainMap.Remove(SizeUInt(self));
179 | end;
180 | result := self;
181 | end;
182 |
183 | begin
184 | AutoRetainMap := TAutoWrapperMap.Create;
185 | AutoRetainMap.Sorted := true;
186 | AutoRetainMap.Duplicates := dupAccept;
187 | AutoReleaseStack := TAutoReleasePoolList.Create;
188 | TAutoReleasePool.Create;
189 | end.
--------------------------------------------------------------------------------
/src/proxy/PasLSProxy.Config.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // Socket-based protocol server - configuration options
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLSProxy.Config;
21 |
22 | {$mode ObjFPC}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | Classes, SysUtils, IniFiles;
28 |
29 |
30 | Const
31 | DefaultSocketUnix = '';
32 | DefaultSocketPort = 9898;
33 | DefaultLogFile = '';
34 |
35 | Type
36 | { TLSPProxyConfig }
37 |
38 | TLSPProxyConfig = Class(TObject)
39 | private
40 | FLogFile: String;
41 | FPort: Word;
42 | FUnix: String;
43 | Public
44 | Constructor Create; virtual;
45 | Procedure Reset; virtual;
46 | class Function DefaultConfigFile : String;
47 | Procedure LoadFromFile(const aFileName : String);
48 | Procedure SaveToFile(const aFileName : String);
49 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual;
50 | Procedure SaveToIni(aIni : TCustomIniFile); virtual;
51 | Public
52 | Property Port : Word Read FPort Write FPort;
53 | Property Unix : String Read FUnix Write FUnix;
54 | Property LogFile : String Read FLogFile Write FLogFile;
55 | end;
56 |
57 |
58 | implementation
59 |
60 | Const
61 | SProxy = 'Proxy';
62 | KeyPort = 'Port';
63 | KeyUnix = 'Unix';
64 | KeyLogFile = 'LogFile';
65 |
66 | { TLSPProxyConfig }
67 |
68 | constructor TLSPProxyConfig.Create;
69 | begin
70 | Reset;
71 | end;
72 |
73 | procedure TLSPProxyConfig.Reset;
74 | begin
75 | FPort:=DefaultSocketPort;
76 | FUnix:=DefaultSocketUnix;
77 | LogFile:=DefaultLogFile;
78 | end;
79 |
80 | class function TLSPProxyConfig.DefaultConfigFile: String;
81 | begin
82 | {$IFDEF UNIX}
83 | Result:='/etc/paslsproxy.cfg';
84 | {$ELSE}
85 | Result:=ChangeFileExt(ParamStr(0),'.ini');
86 | {$ENDIF}
87 | end;
88 |
89 | procedure TLSPProxyConfig.LoadFromFile(const aFileName: String);
90 |
91 | Var
92 | Ini : TCustomIniFile;
93 |
94 | begin
95 | Ini:=TMemIniFile.Create(aFileName);
96 | try
97 | LoadFromIni(Ini);
98 | finally
99 | Ini.Free;
100 | end;
101 | end;
102 |
103 | procedure TLSPProxyConfig.SaveToFile(const aFileName: String);
104 | Var
105 | Ini : TCustomIniFile;
106 |
107 | begin
108 | Ini:=TMemIniFile.Create(aFileName);
109 | try
110 | SaveToIni(Ini);
111 | Ini.UpdateFile;
112 | finally
113 | Ini.Free;
114 | end;
115 | end;
116 |
117 | procedure TLSPProxyConfig.LoadFromIni(aIni: TCustomIniFile);
118 | begin
119 | With aIni do
120 | begin
121 | FPort:=ReadInteger(SProxy,KeyPort,FPort);
122 | FUnix:=ReadString(SProxy,KeyUnix,FUnix);
123 | FLogFile:=ReadString(SProxy,KeyLogFile,LogFile);
124 | end;
125 | end;
126 |
127 | procedure TLSPProxyConfig.SaveToIni(aIni: TCustomIniFile);
128 | begin
129 | With aIni do
130 | begin
131 | WriteInteger(SProxy,KeyPort,FPort);
132 | WriteString(SProxy,KeyUnix,FUnix);
133 | WriteString(SProxy,KeyLogFile,LogFile);
134 | end;
135 | end;
136 |
137 |
138 | end.
139 |
140 |
--------------------------------------------------------------------------------
/src/proxy/paslsproxy.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/proxy/paslsproxy.lpr:
--------------------------------------------------------------------------------
1 | program paslsproxy;
2 |
3 | // Pascal Language Server proxy dispatcher
4 | // Copyright 2023 Michael Van Canneyt
5 |
6 | // This file is part of Pascal Language Server.
7 |
8 | // Pascal Language Server is free software: you can redistribute it
9 | // and/or modify it under the terms of the GNU General Public License
10 | // as published by the Free Software Foundation, either version 3 of
11 | // the License, or (at your option) any later version.
12 |
13 | // Pascal Language Server is distributed in the hope that it will be
14 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
15 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | // GNU General Public License for more details.
17 |
18 | // You should have received a copy of the GNU General Public License
19 | // along with Pascal Language Server. If not, see
20 | // .
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | uses
25 | {$ifdef unix}
26 | cwstring,
27 | {$endif}
28 | { RTL }
29 | SysUtils, Classes, fpjson, jsonparser, jsonscanner,
30 | ssockets, custapp, types,
31 |
32 | { LSP }
33 |
34 | LSP.Messages, LSP.Base, PasLS.TextLoop, PasLS.SocketDispatcher,
35 |
36 | { Pasls }
37 | PasLSProxy.Config;
38 |
39 | Type
40 |
41 | { TLSPProxyApplication }
42 |
43 | TLSPProxyApplication = Class(TCustomApplication)
44 | Private
45 | const
46 | ShortOptions = 'htp:u:c:l:';
47 | LongOptions : Array of string = ('help','test','port:','unix:','config:','log:');
48 | procedure DoHandleDiagnostic(Sender: TObject; const aFrame: TLSPFrame);
49 | Private
50 | FConfig : TLSPProxyConfig;
51 | FContext : TLSPContext;
52 | function ParseOptions(out aParams : TStringDynArray): Boolean;
53 | function SetupTransport: TLSPSocketTransport;
54 | protected
55 | procedure DoRun; override;
56 | Function ExecuteCommandLineMessages(aContext : TLSPContext; aParams : Array of string) : Boolean;
57 |
58 | public
59 | constructor Create(TheOwner: TComponent); override;
60 | destructor Destroy; override;
61 | procedure Usage(const aError: String); virtual;
62 | end;
63 |
64 | procedure TLSPProxyApplication.DoHandleDiagnostic(Sender: TObject; const aFrame: TLSPFrame);
65 |
66 | Type
67 | PFile = ^Text;
68 |
69 | var
70 | aFile : PFile;
71 | aMsg : String;
72 |
73 | begin
74 | aMsg:=aFrame.PayloadString;
75 | FContext.Log('Out of band message of type %s: %s',[aFrame.MessageType.AsString,aMsg]);
76 | case aFrame.MessageType of
77 | lptmDiagnostic:
78 | begin
79 | aFile:=@StdErr;
80 | aMsg:=aMsg+sLineBreak;
81 | end;
82 | lptmMessage:
83 | begin
84 | aFile:=@Output;
85 | WriteLn(aFile^,'Content-Type: ', ContentType);
86 | WriteLn(aFile^,'Content-Length: ', Length(aMsg));
87 | WriteLn(aFile^);
88 | end;
89 | else
90 | aFile:=Nil;
91 | end;
92 | Write(aFile^,aMsg);
93 | Flush(aFile^);
94 | end;
95 |
96 | function TLSPProxyApplication.ExecuteCommandLineMessages(aContext: TLSPContext;
97 | aParams: array of string): Boolean;
98 |
99 | var
100 | i, len: integer;
101 | method, path : String;
102 |
103 | begin
104 | Result:=True;
105 | len:=Length(aParams);
106 | if len =0 then
107 | exit;
108 | if (Len mod 2)= 1 then
109 | begin
110 | writeln(StdErr,'Invalid parameter count of '+ParamCount.ToString+' (must be pairs of 2)');
111 | Exit(false);
112 | end;
113 | I:=0;
114 | while (i'' then
146 | Writeln('Error: ',aError);
147 | Writeln('Pascal Language Server Proxy [',{$INCLUDE %DATE%},']');
148 | Writeln('Usage: ', ExeName, ' [options]');
149 | Writeln('Where options is one or more of:');
150 | Writeln('-h --help This help message');
151 | Writeln('-c --config=FILE Read configuration from file FILE. Default is to read from ',TLSPProxyConfig.DefaultConfigFile);
152 | Writeln('-l --log=FILE Set log file in which to write all log messages');
153 | Writeln('-p --port=NNN Listen on port NNN (default: ',DefaultSocketPort);
154 | Writeln('-t --test Interpret non-option arguments as call/param file pairs and send to server');
155 | Writeln('-u --unix=FILE Listen on unix socket FILE (only on unix-like systems. Default: ',DefaultSocketUnix,')');
156 | Writeln('Only one of -p or -u may be specified, if none is specified then the default is to listen on port 9898');
157 | ExitCode:=Ord(aError<>'');
158 | end;
159 |
160 |
161 | function TLSPProxyApplication.ParseOptions(out aParams: TStringDynArray): Boolean;
162 | var
163 | FN : String;
164 | begin
165 | Result:=False;
166 | FN:=GetOptionValue('c','config');
167 | if FN='' then
168 | FN:=TLSPProxyConfig.DefaultConfigFile;
169 | FConfig.LoadFromFile(FN);
170 | {$IFDEF UNIX}
171 | if HasOption('u','unix') then
172 | FConfig.Unix:=GetOptionValue('u','unix');
173 | {$ENDIF}
174 | if HasOption('p','port') then
175 | FConfig.Port:=StrToInt(GetOptionValue('p','port'));
176 | if HasOption('l','log') then
177 | FConfig.LogFile:=GetOptionValue('l','log');
178 | if HasOption('t','test') then
179 | aParams:=GetNonOptions(ShortOptions,LongOptions)
180 | else
181 | aParams:=[];
182 | Result:=True;
183 | end;
184 |
185 | function TLSPProxyApplication.SetupTransport: TLSPSocketTransport;
186 |
187 | var
188 | aSock : TSocketStream;
189 |
190 | begin
191 | Result:=Nil;
192 | aSock:=Nil;
193 | SetupTextLoop(Input,Output,StdErr);
194 | TLSPContext.LogFile:=FConfig.LogFile;
195 | {$IFDEF UNIX}
196 | // Todo: Add some code to start the socket server, e.g. when the file does not exist.
197 | if FConfig.Unix<>'' then
198 | aSock:=TUnixSocket.Create(FConfig.Unix);
199 | {$ENDIF}
200 | if aSock=Nil then
201 | aSock:=TInetsocket.Create('127.0.0.1',FConfig.Port);
202 | Result:=TLSPSocketTransport.Create(aSock);
203 | Result.OnHandleFrame:=@DoHandleDiagnostic;
204 | end;
205 |
206 | procedure TLSPProxyApplication.DoRun;
207 |
208 | var
209 | aMsg : String;
210 | lParams : TStringDynArray;
211 | aTrans : TLSPSocketTransport;
212 | aDisp : TLSPClientSocketDispatcher;
213 |
214 | begin
215 | Terminate;
216 | lParams:=[];
217 | aMsg:=CheckOptions(ShortOptions, LongOptions);
218 | if HasOption('h','help') then
219 | begin
220 | Usage(aMsg);
221 | exit;
222 | end;
223 | if not ParseOptions(lParams) then
224 | exit;
225 | aTrans:=SetupTransport;
226 | try
227 | aDisp:=TLSPClientSocketDispatcher.Create(aTrans);
228 | FContext:=TLSPContext.Create(aTrans,aDisp,True);
229 | if length(lParams)>0 then
230 | if not ExecuteCommandLineMessages(FContext,lParams) then
231 | exit;
232 | RunMessageLoop(Input,Output,StdErr,FContext);
233 | Finally
234 | FreeAndNil(FContext);
235 | end;
236 | end;
237 |
238 | var
239 | Application: TLSPProxyApplication;
240 |
241 | begin
242 | Application:=TLSPProxyApplication.Create(nil);
243 | Application.Title:='Pascal LSP Server proxy application';
244 | Application.Run;
245 | Application.Free;
246 | end.
247 |
248 | end.
249 |
250 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.AllCommands.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server - Include all command units in a single place, so all commands are available by using this unit.
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.AllCommands;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | Procedure RegisterAllCommands;
27 |
28 | Implementation
29 |
30 | uses
31 | LSP.Base,
32 | // General init etc.
33 | PasLS.General,
34 | // Document
35 | PasLS.Hover,
36 | PasLS.GotoDeclaration,
37 | PasLS.GotoDefinition,
38 | PasLS.Completion,
39 | PasLS.GotoImplementation,
40 | PasLS.SignatureHelp,
41 | PasLS.References,
42 | PasLS.Synchronization,
43 | PasLS.CodeAction,
44 | PasLS.DocumentHighlight,
45 | PasLS.DocumentSymbol,
46 | PasLS.InlayHint,
47 | // Workspace
48 | PasLS.Workspace,
49 | // Custom commands
50 | PasLS.ExecuteCommand,
51 | PasLS.Command.FormatCode,
52 | PasLS.Command.CompleteCode,
53 | PasLS.Command.InvertAssignment,
54 | PasLS.Command.RemoveEmptyMethods;
55 |
56 | procedure RegisterAllCommands;
57 |
58 | begin
59 | // General
60 | LSPHandlerManager.RegisterHandler('initialize', TInitialize);
61 | LSPHandlerManager.RegisterHandler('initialized', TInitialized);
62 | LSPHandlerManager.RegisterHandler('shutdown', TShutdown);
63 | LSPHandlerManager.RegisterHandler('exit', TExit);
64 | LSPHandlerManager.RegisterHandler('$/cancelRequest', TCancel);
65 | // textDocument
66 | LSPHandlerManager.RegisterHandler('textDocument/declaration', TGotoDeclaraction);
67 | LSPHandlerManager.RegisterHandler('textDocument/definition', TGotoDefinition);
68 | LSPHandlerManager.RegisterHandler('textDocument/completion', TCompletion);
69 | LSPHandlerManager.RegisterHandler('textDocument/implementation', TGotoImplementation);
70 | LSPHandlerManager.RegisterHandler('textDocument/references', TReferencesRequest);
71 | LSPHandlerManager.RegisterHandler('textDocument/signatureHelp', TSignatureHelpRequest);
72 | LSPHandlerManager.RegisterHandler('textDocument/didOpen', TDidOpenTextDocument);
73 | LSPHandlerManager.RegisterHandler('textDocument/didClose', TDidCloseTextDocument);
74 | LSPHandlerManager.RegisterHandler('textDocument/didChange', TDidChangeTextDocument);
75 | LSPHandlerManager.RegisterHandler('textDocument/didSave', TDidSaveTextDocument);
76 | LSPHandlerManager.RegisterHandler('textDocument/codeAction', TCodeActionRequest);
77 | LSPHandlerManager.RegisterHandler('textDocument/documentHighlight', TDocumentHighlightRequest);
78 | LSPHandlerManager.RegisterHandler('textDocument/hover', THoverRequest);
79 | LSPHandlerManager.RegisterHandler('textDocument/inlayHint', TInlayHintRequest);
80 | LSPHandlerManager.RegisterHandler('textDocument/documentSymbol', TDocumentSymbolRequest);
81 | // WorkSpace
82 | LSPHandlerManager.RegisterHandler('workspace/didChangeConfiguration', TDidChangeConfiguration);
83 | LSPHandlerManager.RegisterHandler('workspace/didChangeWorkspaceFolders', TDidChangeWorkspaceFolders);
84 | LSPHandlerManager.RegisterHandler('workspace/symbol', TWorkspaceSymbolRequest);
85 | LSPHandlerManager.RegisterHandler('workspace/executeCommand', TExecuteCommandRequest);
86 | end;
87 |
88 | end.
89 |
90 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.ApplyEdit.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.ApplyEdit;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes, SysUtils,
28 | { LSP }
29 | LSP.Messages, LSP.Basic, LSP.Base;
30 |
31 | procedure DoApplyEdit(aTransport: TMessageTransport; DocumentURI, Text: String; Range: TRange);
32 |
33 | implementation
34 |
35 | Uses
36 | { LSP }
37 | PasLS.Settings,
38 | LSP.BaseTypes,
39 | LSP.WorkSpace, PasLS.WorkSpace;
40 |
41 | procedure DoApplyEdit(aTransport: TMessageTransport; DocumentURI, Text: String; Range: TRange);
42 | var
43 | Params: TApplyWorkspaceEditParams;
44 | Edit: TWorkspaceEdit;
45 | TextEdit: TTextEdit;
46 | Msg: TWorkspaceApplyEditRequest;
47 | TextDocumentEdit: TTextDocumentEdit;
48 | begin
49 | Msg := nil;
50 | Params := TApplyWorkspaceEditParams.Create;
51 | try
52 | Edit := Params.edit;
53 |
54 | TextDocumentEdit := Edit.documentChanges.Add;
55 | TextDocumentEdit.textDocument.uri := DocumentURI;
56 |
57 | // TODO: we're hacking around clients by using the versioning system they allow
58 | // but ideally you're supposed to provided correct versions.
59 | // See `OptionalVersionedTextDocumentIdentifier` from
60 | // https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#versionedTextDocumentIdentifier
61 | if ClientInfo.name = TClients.SublimeTextLSP then
62 | TextDocumentEdit.textDocument.version := nil
63 | else
64 | TextDocumentEdit.textDocument.version := 0;
65 |
66 | TextEdit := TextDocumentEdit.edits.Add;
67 | TextEdit.range := range;
68 | TextEdit.newText := Text;
69 |
70 | Msg := TWorkspaceApplyEditRequest.Create(aTransport);
71 | Msg.Execute(params, 'workspace/applyEdit'); // TODO: the class should know it's method name
72 | finally
73 | Params.Free;
74 | Msg.Free;
75 | end;
76 | end;
77 |
78 |
79 | end.
80 |
81 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.CheckInactiveRegions.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | //
20 | // Adapted from fork at:
21 | // https://github.com/coolchyni/pascal-language-server
22 | // (codetoolsutil unit)
23 | //
24 | unit PasLS.CheckInactiveRegions;
25 |
26 | {$mode ObjFPC}{$H+}
27 |
28 | interface
29 |
30 | uses
31 | Classes, SysUtils, FileProcs, LazUtils, LazUtilities,
32 | // Codetools
33 | ExprEval,DefineTemplates,CodeToolManager,CodeCache,LinkScanner,sourcelog,
34 | BasicCodeTools,
35 | //pasls
36 | LSP.Messages;
37 |
38 | type
39 |
40 | { TCheckInactiveRegions }
41 |
42 | TCheckInactiveRegions = class
43 | private
44 | FTransport: TMessageTransport;
45 | Public
46 | Constructor Create(aTransport : TMessageTransport);
47 | procedure Execute(Code:TCodeBuffer;uri:String);
48 | Property Transport : TMessageTransport Read FTransport;
49 | end;
50 |
51 | Procedure CheckInactiveRegions(aTransport : TMessageTransport; aCode : TCodeBuffer; aURI : String);
52 |
53 |
54 | implementation
55 |
56 | uses PasLS.Settings, PasLS.InactiveRegions;
57 |
58 | Procedure CheckInactiveRegions(aTransport : TMessageTransport; aCode : TCodeBuffer; aURI : String);
59 | begin
60 | if ServerSettings.CheckInactiveRegions then
61 | With TCheckInactiveRegions.Create(aTransport) do
62 | try
63 | aTransport.SendDiagnostic('Checking inactive regions');
64 | Execute(aCode,aURI);
65 | finally
66 | Free;
67 | end;
68 | end;
69 |
70 | constructor TCheckInactiveRegions.Create(aTransport: TMessageTransport);
71 | begin
72 | FTransport:=aTransport;
73 | end;
74 |
75 | procedure TCheckInactiveRegions.Execute(Code:TCodeBuffer;uri:String);
76 |
77 | Procedure GetDirectivePos(Scanner: TLinkScanner;Dir : PLSDirective; Out Line,Col : integer);
78 | var
79 | acode:Pointer;
80 | cursorPos:Integer;
81 | begin
82 | Scanner.CleanedPosToCursor(Dir^.CleanPos,cursorPos,acode);
83 | TSourceLog(acode).AbsoluteToLineCol(cursorPos,line,col);
84 | end;
85 |
86 | var
87 | Notification: TInactiveRegionsNotification;
88 | Regions: TRegionsItems;
89 | CurrentRegion: TInputRegion;
90 | Scanner: TLinkScanner;
91 | Dir: PLSDirective;
92 | i, line,col: Integer;
93 | DirectiveText : string;
94 |
95 | begin
96 | if (Code=nil) or Not CodeToolBoss.ExploreUnitDirectives(Code,Scanner) then
97 | exit;
98 | Notification := TInactiveRegionsNotification.Create;
99 | try
100 | Notification.InactiveRegionParams.uri:=uri;
101 | // Easy access
102 | Regions:=Notification.InactiveRegionParams.regions;
103 | CurrentRegion:=nil;
104 | for i:=0 to Scanner.DirectiveCount-1 do
105 | begin
106 | Dir:=Scanner.Directives[i];
107 | if (Dir^.Code<>Pointer(Code)) then
108 | Continue;
109 | GetDirectivePos(Scanner,Dir,Line,Col);
110 | DirectiveText:=ExtractCommentContent(Scanner.CleanedSrc,Dir^.CleanPos,Scanner.NestedComments);
111 | Case Dir^.State of
112 | lsdsInactive:
113 | if Not Assigned(CurrentRegion) then
114 | begin
115 | CurrentRegion:=Regions.Add;
116 | CurrentRegion.startline:=line;
117 | CurrentRegion.startCol:=col+length(DirectiveText)+2;
118 | CurrentRegion.endline:=999999; // will be corrected when end of region is found
119 | end;
120 | lsdsActive:
121 | if Assigned(CurrentRegion) then
122 | begin
123 | CurrentRegion.endline:=line;
124 | CurrentRegion.endCol:=col;
125 | CurrentRegion:=Nil;
126 | end;
127 | lsdsSkipped:
128 | ;
129 | end;
130 | end;
131 | // We must always send: if after an edit the previous ranges become invalid, we need to notify the client.
132 | Notification.Send(Transport);
133 | finally
134 | Notification.Free;
135 | end;
136 | end;
137 |
138 | end.
139 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.CodeAction.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.CodeAction;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | SysUtils, Classes,
29 | { Protocol }
30 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.Streaming, LSP.CodeAction;
31 |
32 | Type
33 | { TCodeActionRequest
34 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_codeAction
35 |
36 | The code action request is sent from the client to the server to compute commands for a
37 | given text document and range. These commands are typically code fixes to either fix
38 | problems or to beautify/refactor code. The result of a textDocument/codeAction request
39 | is an array of Command literals which are typically presented in the user interface.
40 | To ensure that a server is useful in many clients the commands specified in a code actions
41 | should be handled by the server and not by the client (see workspace/executeCommand and
42 | ServerCapabilities.executeCommandProvider). If the client supports providing edits with a
43 | code action then that mode should be used. }
44 |
45 | TCodeActionRequest = class(specialize TLSPRequest)
46 | function Process(var Params: TCodeActionParams): TCodeActionItems; override;
47 | end;
48 |
49 |
50 | implementation
51 |
52 | function TCodeActionRequest.Process(var Params: TCodeActionParams): TCodeActionItems;
53 | begin with Params do
54 | begin
55 | Result := nil;
56 | end;
57 | end;
58 |
59 |
60 | end.
61 |
62 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Command.CompleteCode.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Command.CompleteCode;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes, SysUtils, fpJSON,
28 | { LSP }
29 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands;
30 |
31 |
32 | Type
33 |
34 | { TCompleteCodeCommand }
35 |
36 | TCompleteCodeCommand = Class(TCustomCommand)
37 | private
38 | procedure CompleteCode(DocumentURI: TDocumentUri; line, column: integer);
39 | Protected
40 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override;
41 | Public
42 | Class Function CommandName : string; override;
43 | end;
44 |
45 | implementation
46 |
47 | uses PasLS.ApplyEdit, CodeToolManager, CodeCache, SourceChanger, FindDeclarationTool;
48 |
49 | procedure TCompleteCodeCommand.CompleteCode(DocumentURI: TDocumentUri; line, column: integer);
50 |
51 | var
52 | Path: String;
53 | Code, NewCode: TCodeBuffer;
54 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: Integer;
55 | ARange: TRange;
56 |
57 | begin
58 | // https://wiki.lazarus.freepascal.org/Lazarus_IDE_Tools#Code_Completion
59 |
60 | with CodeToolBoss.SourceChangeCache.BeautifyCodeOptions do
61 | begin
62 | ClassHeaderComments := false;
63 | ClassImplementationComments := false;
64 | ForwardProcBodyInsertPolicy := fpipInFrontOfMethods;
65 | end;
66 |
67 | //Code := CodeToolBoss.LoadFile(URI.path + URI.Document, false, false);
68 | Path := UriToPath(DocumentURI);
69 | Code := CodeToolBoss.FindFile(Path);
70 | Transport.SendDiagnostic(' ▶️ complete code: '+ Path + ' Code: ' + BoolToStr(assigned(Code),'True','False'));
71 | if not CodeToolBoss.CompleteCode(Code, column, line, {TopLine}line, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine, false) then
72 | begin
73 | Transport.SendDiagnostic( '🔴 CompleteCode Failed');
74 | Exit;
75 | end;
76 |
77 | Transport.SendDiagnostic(' ✅ Sucesss NewX: %d NewY: %d NewTopLine: %d BlockTopLine: %d BlockBottomLine: %d', [NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine]);
78 | //procedure AbsoluteToLineCol(Position: integer; out Line, Column: integer);
79 | With Code[Code.Count - 1] do
80 | Transport.SendDiagnostic( 'Position: %d : %d - Length: %d', [Position, Code.GetLineStart(Position),Len]);
81 | // TODO: we need to get character offsets and get the text out of the source
82 | aRange := TRange.Create(0, 0, MaxInt, MaxInt);
83 | try
84 | DoApplyEdit(Transport,DocumentURI, Code.Source, aRange);
85 | finally
86 | aRange.Free;
87 | end;
88 | // TODO: we can do this in one pass with multiple TTextEdits!
89 | // move the cursor
90 | //ApplyEdit(DocumentURI, '', TRange.Create({NewY, NewX}0,0));
91 |
92 | // TODO: goto line next
93 | //pascal-language-server: ✅ Sucesss NewX:3 NewY:83 NewTopLine: 81 BlockTopLine: 81 BlockBottomLine: 84
94 | //range := TRange.Create(NewY, NewX, )
95 | end;
96 |
97 | { TCompleteCodeCommand }
98 |
99 | function TCompleteCodeCommand.DoExecute(aArguments: TJSONArray): TLSPStreamable;
100 |
101 | var
102 | DocumentURI : String;
103 | Position : TPosition;
104 |
105 | begin
106 | Result:=Nil;
107 | documentURI := aArguments.Strings[0];
108 | position := specialize TLSPStreaming.ToObject(aArguments.Objects[1].AsJSON);
109 | try
110 | CompleteCode(documentURI, position.line, position.character);
111 | finally
112 | Position.Free;
113 | end;
114 | end;
115 |
116 | class function TCompleteCodeCommand.CommandName: string;
117 | begin
118 | Result:='pasls.completeCode';
119 | end;
120 |
121 |
122 | Initialization
123 | TCompleteCodeCommand.Register;
124 | end.
125 |
126 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Command.FormatCode.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Command.FormatCode;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | Classes, SysUtils,fpjson,
27 | LSP.BaseTypes, LSP.Base, LSP.Basic, PasLS.Commands;
28 |
29 | Type
30 |
31 | { TFormatCommand }
32 |
33 | TFormatCommand = Class(TCustomCommand)
34 | Protected
35 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override;
36 | Public
37 | Class Function CommandName : string; override;
38 | end;
39 |
40 | implementation
41 |
42 | uses PasLS.Formatter;
43 |
44 | { TFormatCommand }
45 |
46 | function TFormatCommand.DoExecute(aArguments: TJSONArray): TLSPStreamable;
47 |
48 | var
49 | Formatter : TFileFormatter;
50 | FilePath,ConfPath : String;
51 | begin
52 | Result:=Nil;
53 | FilePath := UriToPath(aArguments.Strings[0]);
54 | ConfPath := UriToPath(aArguments.Strings[1]);
55 | Formatter:=TFileFormatter.Create(Transport);
56 | try
57 | Formatter.Process(FilePath,ConfPath);
58 | finally
59 | Formatter.Free;
60 | end;
61 | end;
62 |
63 | class function TFormatCommand.CommandName: string;
64 | begin
65 | Result:='pasls.formatCode';
66 | end;
67 |
68 | initialization
69 | TFormatCommand.Register;
70 | end.
71 |
72 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Command.InvertAssignment.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Command.InvertAssignment;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | Classes, SysUtils, fpJSON,
27 | { LSP }
28 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands;
29 |
30 |
31 | Type
32 |
33 | { TInvertAssignmentCommand }
34 |
35 | TInvertAssignmentCommand = Class(TCustomCommand)
36 | private
37 | procedure InvertAssignment(DocumentURI: TDocumentUri; Range: TRange);
38 | Protected
39 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override;
40 | Public
41 | Class Function CommandName : string; override;
42 | end;
43 |
44 | implementation
45 |
46 | uses PasLS.InvertAssign, PasLS.ApplyEdit, CodeToolManager, CodeCache, FindDeclarationTool;
47 |
48 | { TInvertAssignmentCommand }
49 |
50 | procedure TInvertAssignmentCommand.InvertAssignment(DocumentURI: TDocumentUri; Range: TRange);
51 |
52 | var
53 | Path,S,SL : String;
54 | Code : TCodeBuffer;
55 | I : TInvertAssignment;
56 |
57 | begin
58 | Path := UriToPath(DocumentURI);
59 | Code := CodeToolBoss.FindFile(Path);
60 | if Assigned(Code) then
61 | begin
62 | S:='';
63 | if (Range.start.line0 then
67 | Delete(S,1,Range.start.character);
68 | end;
69 | SL:=Code.GetLine(Range.&end.line);
70 | S:=S+Copy(SL,1,Range.&end.Character+1);
71 | I:=TInvertAssignment.Create;
72 | try
73 | S:=I.InvertAssignment(S);
74 | DoApplyEdit(Transport,DocumentURI,S,Range);
75 | finally
76 | I.Free;
77 | end;
78 | end;
79 | end;
80 |
81 | function TInvertAssignmentCommand.DoExecute(aArguments: TJSONArray
82 | ): TLSPStreamable;
83 |
84 | var
85 | documentURI : String;
86 | range : TRange;
87 | ePos,sPos : TPosition;
88 | begin
89 | Result:=Nil;
90 | documentURI := aArguments.Strings[0];
91 | Range:=Nil;
92 | ePos:=Nil;
93 | sPos:=specialize TLSPStreaming.ToObject(aArguments.Objects[1].AsJSON);
94 | try
95 | ePos:=specialize TLSPStreaming.ToObject(aArguments.Objects[2].AsJSON);
96 | Range:=TRange.Create;
97 | Range.Start:=sPos;
98 | Range.&End:=ePos;
99 | InvertAssignment(documentURI,Range);
100 | finally
101 | sPos.Free;
102 | ePos.Free;
103 | Range.Free;
104 | end;
105 | end;
106 |
107 | class function TInvertAssignmentCommand.CommandName: string;
108 | begin
109 | Result:='pasls.invertAssignment';
110 | end;
111 |
112 | initialization
113 | TInvertAssignmentCommand.Register;
114 | end.
115 |
116 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Command.RemoveEmptyMethods.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Command.RemoveEmptyMethods;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | Classes, SysUtils, fpJSON,
27 | { LSP }
28 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands;
29 |
30 |
31 | Type
32 |
33 | { TRemoveEmptymethodsCommand }
34 |
35 | TRemoveEmptymethodsCommand = Class(TCustomCommand)
36 | private
37 | procedure RemoveEmptymethods(DocumentURI: TDocumentUri; aPos : TPosition);
38 | Protected
39 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override;
40 | Public
41 | Class Function CommandName : string; override;
42 | end;
43 |
44 | implementation
45 |
46 | uses PasLS.RemoveEmptyMethods;
47 |
48 | { TRemoveEmptymethodsCommand }
49 |
50 | procedure TRemoveEmptymethodsCommand.RemoveEmptymethods(
51 | DocumentURI: TDocumentUri; aPos: TPosition);
52 |
53 | var
54 | Rem: TRemoveEmptyMethods;
55 |
56 | begin
57 | Rem:=TRemoveEmptyMethods.Create(Transport);
58 | try
59 | Rem.Execute(documentURI,aPos);
60 | finally
61 | Rem.Free;
62 | end;
63 | end;
64 |
65 | function TRemoveEmptymethodsCommand.DoExecute(aArguments: TJSONArray
66 | ): TLSPStreamable;
67 |
68 | var
69 | documentURI : String;
70 | position : TPosition;
71 |
72 | begin
73 | Result:=nil;
74 | documentURI := aArguments.Strings[0];
75 | position := specialize TLSPStreaming.ToObject(aArguments.Objects[1].AsJSON);
76 | try
77 | RemoveEmptymethods(documentUri,Position);
78 | finally
79 | Position.Free;
80 | end;
81 | end;
82 |
83 | class function TRemoveEmptymethodsCommand.CommandName: string;
84 | begin
85 | Result:='pasls.removeEmptyMethods';
86 | end;
87 |
88 | initialization
89 | TRemoveEmptymethodsCommand.Register;
90 | end.
91 |
92 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Commands.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.Commands;
21 |
22 | {$mode objfpc}{$H+}
23 | {$codepage UTF8}
24 |
25 | interface
26 | uses
27 | { RTL }
28 | SysUtils, Classes, Types, FPJSON,
29 | { LSP }
30 | LSP.BaseTypes, LSP.Messages ;
31 |
32 | Type
33 |
34 | { TCustomCommand }
35 |
36 | TCustomCommand = class
37 | private
38 | FTransport: TMessageTransport;
39 | Protected
40 | function DoExecute(aArguments : TJSONArray) : TLSPStreamable; virtual; abstract;
41 | Public
42 | class Function CommandName : String; virtual;
43 | class Procedure Register;
44 | class procedure UnRegister;
45 | Constructor Create(aTransport : TMessageTransport); virtual;
46 | function Execute(aArguments : TJSONArray) : TLSPStreamable;
47 | Property Transport : TMessageTransport Read FTransport;
48 | end;
49 | TCustomCommandClass = class of TCustomCommand;
50 |
51 | { TCommandDef }
52 |
53 | TCommandDef = Class(TCollectionItem)
54 | private
55 | FClass: TCustomCommandClass;
56 | function GetCommandName: String;
57 | Public
58 | property CommandClass : TCustomCommandClass Read FClass Write FClass;
59 | Property CommandName : String Read GetCommandName;
60 | end;
61 |
62 | { TCommandDefs }
63 |
64 | TCommandDefs = Class(TCollection)
65 | private
66 | FCommandCount: Integer;
67 | function GetDef(aIndex: Integer): TCommandDef;
68 | procedure SetDef(aIndex: Integer; AValue: TCommandDef);
69 | Public
70 | function Add(aCommandClass : TCustomCommandClass) : TCommandDef;
71 | function IndexOfCommandClass(aCommandClass : TCustomCommandClass) : Integer;
72 | function IndexOfCommand(const aName : String) : Integer;
73 | function FindCommand(const aName: String): TCommandDef;
74 | function FindCommandClass(aCommandClass : TCustomCommandClass): TCommandDef;
75 | function Remove(aCommandClass : TCustomCommandClass) : Boolean;
76 | Property Commands[aIndex: Integer] : TCommandDef Read GetDef Write SetDef; default;
77 | Property CommandCount : Integer Read FCommandCount;
78 | end;
79 |
80 | { TCommandFactory }
81 |
82 | TCommandFactory = class
83 | private
84 | class var _instance : TCommandFactory;
85 | private
86 | FList : TCommandDefs;
87 | public
88 | Class Constructor Init;
89 | Class Destructor Done;
90 | Constructor Create;
91 | Destructor Destroy; override;
92 | Procedure RegisterCommand(aCommand : TCustomCommandClass);
93 | Procedure UnregisterCommand(aCommand : TCustomCommandClass);
94 | Function FindCommand(const aName : String) : TCommandDef;
95 | Function FindCommandClass(const aName : String) : TCustomCommandClass;
96 | Procedure GetCommandList(L : TStrings);
97 | Function GetCommandNames : TStringDynArray;
98 | Class Property Instance : TCommandFactory Read _Instance;
99 | end;
100 |
101 | Function CommandFactory : TCommandFactory;
102 |
103 |
104 | implementation
105 | uses
106 | CodeToolManager,
107 | FindDeclarationTool,
108 |
109 | { Protocols }
110 | LSP.Workspace, PasLS.Settings;
111 |
112 | function CommandFactory: TCommandFactory;
113 | begin
114 | Result:=TCommandFactory.Instance;
115 | end;
116 |
117 |
118 |
119 |
120 | { TCustomCommand }
121 |
122 | class function TCustomCommand.CommandName: String;
123 | begin
124 | Result:=ClassName;
125 | if Result[1]='T' then
126 | Delete(Result,1,1);
127 | end;
128 |
129 | class procedure TCustomCommand.Register;
130 | begin
131 | TCommandFactory.Instance.RegisterCommand(Self);
132 | end;
133 |
134 | class procedure TCustomCommand.UnRegister;
135 | begin
136 | TCommandFactory.Instance.UnRegisterCommand(Self);
137 | end;
138 |
139 | constructor TCustomCommand.Create(aTransport: TMessageTransport);
140 | begin
141 | FTransport:=aTransport;
142 | end;
143 |
144 | function TCustomCommand.Execute(aArguments: TJSONArray): TLSPStreamable;
145 | begin
146 | // Maybe later we can add some logging etc. here.
147 | Result:=DoExecute(aArguments);
148 | end;
149 |
150 | { TCommandDef }
151 |
152 | function TCommandDef.GetCommandName: String;
153 | begin
154 | Result:='';
155 | if Assigned(CommandClass) then
156 | Result:=CommandClass.CommandName;
157 | end;
158 |
159 | { TCommandDefs }
160 |
161 | function TCommandDefs.GetDef(aIndex: Integer): TCommandDef;
162 | begin
163 | Result:=Items[aIndex] as TCommandDef;
164 | end;
165 |
166 | procedure TCommandDefs.SetDef(aIndex: Integer; AValue: TCommandDef);
167 | begin
168 | Items[aIndex]:=aValue;
169 | end;
170 |
171 | function TCommandDefs.Add(aCommandClass: TCustomCommandClass): TCommandDef;
172 | begin
173 | if IndexOfCommand(aCommandClass.CommandName)<>-1 then
174 | Raise EListError.CreateFmt('Duplicate command: %s',[aCommandClass.CommandName]);
175 | Result:=(Inherited Add) as TCommandDef;
176 | Result.CommandClass:=aCommandClass;
177 | end;
178 |
179 | function TCommandDefs.IndexOfCommandClass(aCommandClass: TCustomCommandClass
180 | ): Integer;
181 | begin
182 | Result:=Count-1;
183 | While (Result>=0) and (GetDef(Result).CommandClass<>aCommandClass) do
184 | Dec(Result);
185 | end;
186 |
187 | function TCommandDefs.IndexOfCommand(const aName: String): Integer;
188 | begin
189 | Result:=Count-1;
190 | While (Result>=0) and Not SameText(GetDef(Result).CommandName,aName) do
191 | Dec(Result);
192 | end;
193 |
194 | function TCommandDefs.FindCommand(const aName: String): TCommandDef;
195 |
196 | var
197 | Idx : Integer;
198 |
199 | begin
200 | Result:=nil;
201 | Idx:=IndexOfCommand(aName);
202 | If Idx<>-1 then
203 | Result:=Commands[Idx];
204 | end;
205 |
206 | function TCommandDefs.FindCommandClass(aCommandClass: TCustomCommandClass
207 | ): TCommandDef;
208 | var
209 | Idx : Integer;
210 |
211 | begin
212 | Result:=nil;
213 | Idx:=IndexOfCommandClass(aCommandClass);
214 | If Idx<>-1 then
215 | Result:=Commands[Idx];
216 | end;
217 |
218 | function TCommandDefs.Remove(aCommandClass: TCustomCommandClass): Boolean;
219 |
220 | var
221 | Def : TCommandDef;
222 |
223 | begin
224 | Def:=FindCommandClass(aCommandClass);
225 | Result:=Def<>Nil;
226 | if Result then
227 | Def.Free;
228 | end;
229 |
230 | { TCommandFactory }
231 |
232 | class constructor TCommandFactory.Init;
233 | begin
234 | _Instance:=TCommandFactory.Create
235 | end;
236 |
237 | class destructor TCommandFactory.Done;
238 | begin
239 | FreeAndNil(_Instance);
240 | end;
241 |
242 | constructor TCommandFactory.Create;
243 | begin
244 | FList:=TCommandDefs.Create(TCommandDef);
245 | end;
246 |
247 | destructor TCommandFactory.Destroy;
248 | begin
249 | FreeAndNil(FList);
250 | inherited Destroy;
251 | end;
252 |
253 | procedure TCommandFactory.RegisterCommand(aCommand: TCustomCommandClass);
254 |
255 | begin
256 | FList.Add(aCommand);
257 | end;
258 |
259 | procedure TCommandFactory.UnregisterCommand(aCommand: TCustomCommandClass);
260 | begin
261 | FList.Remove(aCommand);
262 | end;
263 |
264 | function TCommandFactory.FindCommand(const aName: String): TCommandDef;
265 | begin
266 | Result:=FList.FindCommand(aName);
267 | end;
268 |
269 | function TCommandFactory.FindCommandClass(const aName: String): TCustomCommandClass;
270 |
271 | var
272 | aDef : TCommandDef;
273 |
274 | begin
275 | Result:=nil;
276 | aDef:=FindCommand(aName);
277 | if Assigned(aDef) then
278 | Result:=aDef.CommandClass;
279 | end;
280 |
281 | procedure TCommandFactory.GetCommandList(L: TStrings);
282 |
283 | Var
284 | i : Integer;
285 |
286 | begin
287 | For I:=0 to FList.Count-1 do
288 | L.Add(FList[i].CommandName);
289 | end;
290 |
291 | function TCommandFactory.GetCommandNames: TStringDynArray;
292 |
293 | var
294 | L : TStrings;
295 |
296 | begin
297 | L:=TStringList.Create;
298 | try
299 | GetCommandList(L);
300 | Result:=L.ToStringArray;
301 | finally
302 | L.Free;
303 | end;
304 | end;
305 |
306 | end.
307 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.DocumentHighlight.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.DocumentHighlight;
21 |
22 |
23 | {$mode objfpc}{$H+}
24 | {$scopedenums on}
25 |
26 | interface
27 |
28 | uses
29 | { RTL }
30 | SysUtils, Classes,
31 | { Code Tools }
32 | CodeToolManager, CodeCache,
33 | { Protocol }
34 | LSP.Base, LSP.Basic,
35 | { Other }
36 | LSP.BaseTypes, PasLS.CodeUtils, LSP.DocumentHighlight;
37 |
38 | Type
39 | { TDocumentHighlightRequest
40 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_documentHighlight
41 |
42 | The document highlight request is sent from the client to the server to resolve a
43 | document highlights for a given text document position. For programming languages
44 | this usually highlights all references to the symbol scoped to this file.
45 | However we kept `textDocument/documentHighlight` and `textDocument/references`
46 | separate requests since the first one is allowed to be more fuzzy.
47 | Symbol matches usually have a DocumentHighlightKind of Read or Write whereas fuzzy or
48 | textual matches use Textas the kind. }
49 |
50 | TDocumentHighlightRequest = class(specialize TLSPRequest)
51 | function Process(var Params: TDocumentHighlightParams): TDocumentHighlightItems; override;
52 | end;
53 |
54 | implementation
55 |
56 |
57 | function TDocumentHighlightRequest.Process(var Params: TDocumentHighlightParams): TDocumentHighlightItems;
58 | var
59 | Code: TCodeBuffer;
60 | X, Y: Integer;
61 | NewCode: TCodeBuffer;
62 | NewX, NewY, NewTopLine: integer;
63 |
64 | begin
65 | Result:=TDocumentHighlightItems.Create;
66 | with Params do
67 | begin
68 | Code := CodeToolBoss.FindFile(textDocument.LocalPath);
69 | X := position.character + 1;
70 | Y := position.line + 1;
71 |
72 | if CodeToolBoss.FindBlockCounterPart(Code, X, Y, NewCode, NewX, NewY, NewTopLine) then
73 | begin
74 | // Show start/end indentifier if the range spans more than 1 line
75 | if NewY - Y <> 0 then
76 | begin
77 | TDocumentHighlight.Create(Result,TDocumentHighlightKind.Text, GetIdentifierRangeAtPos(NewCode, NewX, NewY - 1));
78 | TDocumentHighlight.Create(Result,TDocumentHighlightKind.Text, GetIdentifierRangeAtPos(NewCode, X, Y - 1))
79 | end
80 | else
81 | begin
82 | // TODO: make this an option to show single line ranges?
83 | //Item := TDocumentHighlight(Result.Add);
84 | //Item.kind := TDocumentHighlightKind.Text;
85 | //Item.range := TRange.Create(NewY - 1, NewX - 1, Y - 1, X - 1);
86 | end;
87 | end
88 | else
89 | end;
90 | end;
91 |
92 |
93 | end.
94 |
95 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.DocumentSymbol.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.DocumentSymbol;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes, FPJson, FPJsonRPC,
28 | { Code Tools }
29 | CodeToolManager, LinkScanner,
30 | { Protocol }
31 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.Streaming, LSP.DocumentSymbol;
32 |
33 | Type
34 | { The document symbol request is sent from the client to the server. The returned result is either:
35 |
36 | * SymbolInformation[] which is a flat list of all symbols found in a given text document.
37 | Then neither the symbol’s location range nor the symbol’s container name should be used to infer a hierarchy.
38 | * DocumentSymbol[] which is a hierarchy of symbols found in a given text document. }
39 |
40 | TDocumentSymbolRequest = class(specialize TLSPRequest)
41 | function DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; override;
42 | end;
43 |
44 |
45 | implementation
46 |
47 | uses
48 | { RTL }
49 | SysUtils, FileUtil, DateUtils, fpjsonrtti,
50 | { Code Tools }
51 |
52 | FindDeclarationTool, KeywordFuncLists,
53 | { Protocol }
54 | PasLS.Symbols;
55 |
56 |
57 | { TDocumentSymbolRequest }
58 |
59 | function TDocumentSymbolRequest.DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData;
60 | var
61 | Input: TDocumentSymbolParams;
62 | Path: String;
63 | begin
64 | Input := specialize TLSPStreaming.ToObject(Params);
65 | try
66 | Path := Input.textDocument.LocalPath;
67 | Result := SymbolManager.FindDocumentSymbols(Path);
68 | if not Assigned(Result) then
69 | Result := TJSONNull.Create;
70 | finally
71 | Input.Free;
72 | end;
73 | end;
74 |
75 |
76 | end.
77 |
78 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.ExecuteCommand.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.ExecuteCommand;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | SysUtils, Classes, FPJSON,
28 | { Protocol }
29 | LSP.BaseTypes, LSP.Base, LSP.Streaming, LSP.WorkDoneProgress, LSP.ExecuteCommand;
30 |
31 | Type
32 | { TExecuteCommandRequest
33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspace_executeCommand
34 |
35 | The `workspace/executeCommand` request is sent from the client to the server to trigger
36 | command execution on the server. In most cases the server creates a `WorkspaceEdit` structure
37 | and applies the changes to the workspace using the request `workspace/applyEdit` which is sent
38 | from the server to the client.
39 |
40 | Response:
41 |
42 | result: LSPAny | null
43 | error: code and message set in case an exception happens during the request.
44 | }
45 |
46 | TExecuteCommandRequest = class(specialize TLSPRequest)
47 | function Process(var Params: TExecuteCommandParams): TLSPStreamable; override;
48 | end;
49 |
50 |
51 | implementation
52 |
53 | uses
54 | PasLS.Commands;
55 |
56 | function TExecuteCommandRequest.Process(var Params: TExecuteCommandParams): TLSPStreamable;
57 | var
58 | aCommandClass : TCustomCommandClass;
59 | aCommand : TCustomCommand;
60 |
61 | begin
62 | result := nil;
63 | aCommandClass:=CommandFactory.FindCommandClass(Params.command);
64 | if aCommandClass<>Nil then
65 | try
66 | aCommand:=aCommandClass.Create(Self.Transport);
67 | result:=aCommand.Execute(Params.Arguments);
68 | finally
69 | aCommand.Free;
70 | end;
71 | { case command of
72 | 'pasls.formatCode':
73 | begin
74 | end;
75 | 'pasls.invertAssignment':
76 | begin
77 | end;
78 | end;}
79 |
80 | end;
81 |
82 | initialization
83 |
84 |
85 | end.
86 |
87 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.GotoDeclaration.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.GotoDeclaration;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes, CodeToolManager, CodeCache,
29 | { Protocol }
30 | LSP.Base, LSP.Basic;
31 |
32 | type
33 |
34 | { TGotoDeclaraction }
35 |
36 | TGotoDeclaraction = class(specialize TLSPRequest)
37 | function Process(var Params: TTextDocumentPositionParams): TLocation; override;
38 | end;
39 |
40 | implementation
41 |
42 | uses
43 | PasLS.Diagnostics;
44 |
45 | function TGotoDeclaraction.Process(var Params: TTextDocumentPositionParams): TLocation;
46 | var
47 | Code: TCodeBuffer;
48 | NewCode: TCodeBuffer;
49 | X, Y: Integer;
50 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
51 |
52 | begin with Params do
53 | begin
54 | Code := CodeToolBoss.FindFile(textDocument.LocalPath);
55 | X := position.character;
56 | Y := position.line;
57 |
58 | if CodeToolBoss.FindDeclaration(Code, X + 1, Y + 1, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine) then
59 | begin
60 | Result := TLocation.Create(NewCode.Filename,NewY - 1,NewX-1,0);
61 | end
62 | else
63 | begin
64 | Result := nil;
65 | PublishCodeToolsError(Transport,'');
66 | end;
67 | end;
68 | end;
69 |
70 | end.
71 |
72 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.GotoDefinition.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.GotoDefinition;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes,
29 | { Code Tools }
30 | CodeToolManager, CodeCache,
31 | { Protocol }
32 | LSP.Base, LSP.Basic;
33 |
34 | type
35 |
36 | { TGotoDefinition }
37 |
38 | TGotoDefinition = class(specialize TLSPRequest)
39 | function Process(var Params: TTextDocumentPositionParams): TLocation; override;
40 | end;
41 |
42 | implementation
43 |
44 | uses
45 | PasLS.Diagnostics;
46 |
47 | function TGotoDefinition.Process(var Params: TTextDocumentPositionParams): TLocation;
48 | var
49 | Code: TCodeBuffer;
50 | NewCode: TCodeBuffer;
51 | X, Y: Integer;
52 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
53 | begin with Params do
54 | begin
55 | Code := CodeToolBoss.FindFile(textDocument.localPath);
56 | X := position.character;
57 | Y := position.line;
58 | {
59 | NOTE: currently goto definition is supported as goto declaration
60 |
61 | There is a definition for the following identifiers:
62 |
63 | - Methods
64 |
65 | There is no definition for the following identifiers:
66 |
67 | - Function forwards
68 | - Functions in the interface section
69 | - External functions
70 | - Class forwards
71 | - External ObjC classes
72 |
73 | https://www.cprogramming.com/declare_vs_define.html
74 | https://stackoverflow.com/questions/1410563/what-is-the-difference-between-a-definition-and-a-declaration
75 | }
76 | if CodeToolBoss.FindDeclaration(Code, X + 1, Y + 1, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine) then
77 | begin
78 | Result := TLocation.Create(NewCode.Filename,NewY - 1, NewX - 1,0)
79 | end
80 | else
81 | begin
82 | Result := nil;
83 | PublishCodeToolsError(Transport,'');
84 | end;
85 | end;
86 | end;
87 |
88 | end.
89 |
90 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.GotoImplementation.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.GotoImplementation;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | Classes,
29 | { Code Tools }
30 | CodeToolManager, CodeCache,
31 | { Protocol }
32 | LSP.Base, LSP.Basic;
33 |
34 | type
35 |
36 | { TGotoImplementation }
37 |
38 | TGotoImplementation = class(specialize TLSPRequest)
39 | function Process(var Params: TTextDocumentPositionParams): TLocation; override;
40 | end;
41 |
42 | implementation
43 |
44 | uses
45 | PasLS.Diagnostics, LSP.Diagnostics;
46 |
47 | function TGotoImplementation.Process(var Params: TTextDocumentPositionParams): TLocation;
48 | var
49 | Code: TCodeBuffer;
50 | NewCode: TCodeBuffer;
51 | X, Y: Integer;
52 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
53 | RevertableJump: boolean;
54 | begin with Params do
55 | begin
56 | Code := CodeToolBoss.FindFile(TextDocument.LocalPath);
57 | X := position.character;
58 | Y := position.line;
59 |
60 | if CodeToolBoss.JumpToMethod(Code, X + 1, Y + 1,
61 | NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine, RevertableJump) then
62 | begin
63 | Result := TLocation.Create(NewCode.Filename,NewY - 1, NewX - 1,0);
64 | end
65 | else
66 | begin
67 | PublishCodeToolsError(Transport,'');
68 | Result := nil;
69 | end;
70 | end;
71 | end;
72 |
73 | end.
74 |
75 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Hover.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Hover;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { Code Tools }
27 | CodeToolManager, CodeCache,
28 | { Protocol }
29 | LSP.BaseTypes,LSP.Base, LSP.Hover, LSP.Basic;
30 |
31 | Type
32 | { THoverRequest }
33 |
34 | THoverRequest = class(specialize TLSPRequest)
35 | function Process(var Params: TTextDocumentPositionParams): THoverResponse; override;
36 | end;
37 |
38 |
39 | implementation
40 |
41 | uses
42 | SysUtils;
43 |
44 | function THoverRequest.Process(var Params: TTextDocumentPositionParams): THoverResponse;
45 | var
46 |
47 | Code: TCodeBuffer;
48 | X, Y: Integer;
49 | Hint: String;
50 | begin with Params do
51 | begin
52 | Code := CodeToolBoss.FindFile(textDocument.LocalPath);
53 | X := position.character;
54 | Y := position.line;
55 |
56 | try
57 | Hint := CodeToolBoss.FindSmartHint(Code, X + 1, Y + 1);
58 | // empty hint string means nothing was found
59 | if Hint = '' then
60 | exit(nil);
61 | except
62 | on E: Exception do
63 | begin
64 | LogError('Hover Error',E);
65 | exit(nil);
66 | end;
67 | end;
68 |
69 | // https://facelessuser.github.io/sublime-markdown-popups/
70 | // Wrap hint in markdown code
71 | Hint:='```pascal'+#10+Hint+#10+'```';
72 |
73 | Result := THoverResponse.Create;
74 | Result.contents.PlainText:=False;
75 | Result.contents.value:=Hint;
76 | Result.range.SetRange(Y, X);
77 | end;
78 | end;
79 |
80 |
81 | end.
82 |
83 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.InactiveRegions.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.InactiveRegions;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { Rtl }
28 | SysUtils, Classes,
29 | { Pasls }
30 | LSP.Base, LSP.BaseTypes, LSP.Messages;
31 |
32 | type
33 | { TInputRegion }
34 | TInputRegion = class(TCollectionItem)
35 | private
36 | fStartline:Integer;
37 | fStartCol:Integer;
38 | fEndline:Integer;
39 | fEndCol:Integer;
40 | Public
41 | Procedure Assign(aSource : TPersistent); override;
42 | published
43 | property startLine: Integer read fStartline write fStartline;
44 | property startCol: Integer read fStartCol write fStartCol;
45 | property endLine: Integer read fEndline write fEndline;
46 | property endCol: Integer read fEndCol write fEndCol;
47 | end;
48 |
49 | TRegionsItems = specialize TGenericCollection;
50 |
51 | { TInactiveRegionParams }
52 |
53 | TInactiveRegionParams=class(TLSPStreamable)
54 | private
55 | fUri:string;
56 | fFileVersion:Integer;
57 | fRegions:TRegionsItems;
58 | procedure SetRegions(AValue: TRegionsItems);
59 | Public
60 | Constructor Create; override;
61 | Destructor Destroy; override;
62 | published
63 | property uri : string read fUri write fUri;
64 | property fileVersion : Integer read fFileVersion write fFileVersion;
65 | property regions : TRegionsItems read fRegions write SetRegions;
66 | end;
67 |
68 |
69 | { TInactiveRegionsNotification }
70 | { The message notification is sent from a server to a client to ask
71 | the client to display a inactive region in the user interface. }
72 |
73 | TInactiveRegionsNotification = class(TNotificationMessage)
74 | private
75 | function GetParams: TInactiveRegionParams;
76 | public
77 | constructor Create; override;
78 | Property InactiveRegionParams: TInactiveRegionParams Read GetParams;
79 | destructor Destroy; override;
80 | end;
81 |
82 | implementation
83 |
84 | { TInputRegion }
85 |
86 | procedure TInputRegion.Assign(aSource: TPersistent);
87 |
88 | var
89 | Reg : TInputRegion absolute aSource;
90 |
91 | begin
92 | if (aSource is TInputRegion) then
93 | begin
94 | Startline:=Reg.Startline;
95 | StartCol:=Reg.StartCol;
96 | Endline:=Reg.EndLine;
97 | EndCol:=Reg.EndCol;
98 | end
99 | else
100 | inherited Assign(aSource);
101 | end;
102 |
103 | { TInactiveRegionParams }
104 |
105 | procedure TInactiveRegionParams.SetRegions(AValue: TRegionsItems);
106 | begin
107 | if fRegions=AValue then Exit;
108 | fRegions.Assign(AValue);
109 | end;
110 |
111 | constructor TInactiveRegionParams.Create;
112 | begin
113 | inherited Create;
114 | fRegions:=TRegionsItems.Create;
115 | end;
116 |
117 | destructor TInactiveRegionParams.Destroy;
118 | begin
119 | FreeAndNil(fRegions);
120 | inherited Destroy;
121 | end;
122 |
123 | function TInactiveRegionsNotification.GetParams: TInactiveRegionParams;
124 | begin
125 | Result:=(Inherited Params) as TInactiveRegionParams
126 | end;
127 |
128 | constructor TInactiveRegionsNotification.Create;
129 | begin
130 | params := TInactiveRegionParams.Create;
131 | method := 'pasls.inactiveRegions';
132 | end;
133 |
134 | destructor TInactiveRegionsNotification.Destroy;
135 | begin
136 | FreeAndNil(fparams);
137 | inherited;
138 | end;
139 |
140 | end.
141 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.InlayHint.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2022 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.InlayHint;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes, SysUtils,
28 | { LSP Protocol }
29 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.InlayHint;
30 |
31 | Type
32 | { TInlayHintRequest
33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_inlayHint
34 |
35 | The inlay hints request is sent from the client to the server to compute inlay hints for a given [text document, range] tuple that may be rendered in the editor in place with other text. }
36 |
37 | TInlayHintRequest = class(specialize TLSPRequest)
38 | function Process(var Params: TInlayHintParams): TInlayHints; override;
39 | end;
40 |
41 |
42 | implementation
43 |
44 | { TInlayHintRequest }
45 |
46 | function TInlayHintRequest.Process(var Params: TInlayHintParams): TInlayHints;
47 | {var
48 | hint: TInlayHint;}
49 | begin with Params do
50 | //hint := TInlayHint(result.Add);
51 | //hint.position := TPosition.Create(0, 0);
52 | //hint.&label := 'number';
53 | //hint.tooltip := 'paramter name tooltip';
54 | result := TInlayHints.Create;
55 | end;
56 |
57 | end.
58 |
59 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.InvertAssign.pas:
--------------------------------------------------------------------------------
1 | {
2 | ***************************************************************************
3 | * *
4 | * This source is free software; you can redistribute it and/or modify *
5 | * it under the terms of the GNU General Public License as published by *
6 | * the Free Software Foundation; either version 2 of the License, or *
7 | * (at your option) any later version. *
8 | * *
9 | * This code is distributed in the hope that it will be useful, but *
10 | * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 | * General Public License for more details. *
13 | * *
14 | * A copy of the GNU General Public License is available on the World *
15 | * Wide Web at . You can also *
16 | * obtain it by writing to the Free Software Foundation, *
17 | * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 | * *
19 | ***************************************************************************
20 |
21 | Author: Sérgio Marcelo S. Gomes
22 | Modified by Andrew Haines and Juha Manninen
23 | Adapted for LSP by Michael Van Canneyt
24 |
25 | Abstract: Invert Assignment Code.
26 |
27 | Example: AValue := BValue -> BValue := AValue;
28 | AValue := True -> AValue := False;
29 |
30 | }
31 | unit PasLS.InvertAssign;
32 |
33 | {$mode objfpc}{$H+}
34 |
35 | interface
36 |
37 | uses
38 | Classes, SysUtils;
39 |
40 | type
41 |
42 | { TInvertAssignment }
43 | TInvertAssignOption = (iaoSpaceBefore,iaoSpaceAfter,iaoAlign);
44 | TInvertAssignOptions = set of TInvertAssignOption;
45 |
46 | TInvertAssignment = Class
47 | private
48 | FOptions: TInvertAssignOptions;
49 | class procedure DivideLines(Lines: TStrings; var PreList, AList, BList, PostList: TStrings); virtual;
50 | class function GetIndent(ALine: String): Integer; virtual;
51 | class function IsAWholeLine(const ALine: String): Boolean; virtual;
52 | function InvertLine(PreVar, VarA, VarB, PostVar: String; LineStart, EqualPosition: Integer): String; virtual;
53 | Public
54 | function InvertAssignment(InText: string): string;
55 | procedure InvertAssignment(Lines: TStrings);
56 | Property Options : TInvertAssignOptions Read FOptions Write FOptions;
57 | end;
58 |
59 | implementation
60 |
61 |
62 | class function TInvertAssignment.GetIndent(ALine: String):Integer;
63 | begin
64 | Result := Length(Aline) - Length(TrimLeft(ALine));
65 | end;
66 |
67 | class procedure TInvertAssignment.DivideLines(Lines: TStrings; var PreList, AList, BList, PostList: TStrings);
68 | var
69 | ALine, TrueFalse: String;
70 | t, f: Boolean;
71 | X, I, EqPos, SemiPos, WordEndPos, BracketCount: Integer;
72 | begin
73 | for X := 0 to Lines.Count-1 do begin
74 | ALine := Trim(Lines[X]);
75 | EqPos := Pos(':=', ALine);
76 | if EqPos > 0 then begin
77 | SemiPos := Pos(';', ALine);
78 | if SemiPos = 0 then
79 | SemiPos:=Length(ALine)+1;
80 | I := EqPos-1;
81 | while (I > 0) and (ALine[I] = ' ') do // Skip initial spaces
82 | Dec(I);
83 | WordEndPos := I+1;
84 | BracketCount := 0;
85 | // Get the word before :=
86 | while I > 0 do begin
87 | if ALine[I] = ']' then
88 | Inc(BracketCount)
89 | else if ALine[I] = '[' then
90 | Dec(BracketCount);
91 | if (BracketCount = 0) and (ALine[I] = ' ') then
92 | Break;
93 | Dec(I);
94 | end;
95 | // I points now at beginning of word - 1
96 | Alist.Add(Copy(ALine, I+1, WordEndPos-(I+1)));
97 | BList.Add(Trim(Copy(ALine, EqPos+2, SemiPos-EqPos-2)));
98 | PreList.Add(Trim(Copy(ALine,1, I)));
99 | PostList.Add(Trim(Copy(ALine, SemiPos, Length(ALine)-(SemiPos-1))));
100 | if Length(PreList[X]) > 0 then
101 | PreList[X] := PreList[X] + ' ';
102 | end
103 | else begin // not a valid line
104 | PreList.Add('');
105 | AList.Add(ALine);
106 | Blist.Add('');
107 | PostList.Add('');
108 | end;
109 | // Check if is being assigned true or false
110 | t := CompareText(BList[X], 'True') = 0;
111 | f := CompareText(BList[X], 'False') = 0;
112 | if t or f then begin
113 | TrueFalse := AList[X];
114 | AList[X] := BoolToStr(not t, 'True', 'False');
115 | BList[X] := TrueFalse;
116 | end;
117 | end;
118 | end;
119 |
120 | function TInvertAssignment.InvertLine(PreVar, VarA, VarB, PostVar: String;
121 | LineStart, EqualPosition: Integer): String;
122 | var
123 | fLength: Integer;
124 | op : string;
125 |
126 | begin
127 | Result := StringOfChar(' ',LineStart);
128 | if Length(Trim(VarB)) = 0 then // is not a line with a ':='
129 | Result := Result + VarA
130 | else
131 | begin
132 | Result := Result + PreVar + VarB;
133 | fLength := Length(Trim(Result));
134 | if (iaoAlign in Options) and (fLength < EqualPosition) then
135 | Result := Result + StringOfChar(' ', EqualPosition-fLength) ;
136 | Op:=':=';
137 | if iaoSpaceBefore in Options then
138 | op:=' '+op;
139 | if iaoSpaceAfter in Options then
140 | op:=op+' ';
141 | Result := Result + Op + VarA + PostVar;
142 | end;
143 | end;
144 |
145 | class function TInvertAssignment.IsAWholeLine(const ALine: String): Boolean;
146 |
147 | var
148 | S : String;
149 |
150 | begin
151 | // This function is useful for when the text is put back
152 | // in the synedit, things like this don't happen:
153 | // begin
154 | // if CallSomeFunction > 0
155 | // then
156 | // DoThis
157 | // else
158 | // Exit;
159 | // end;
160 | //
161 | // Would otherwise become this
162 | //
163 | // begin if CallSomeFunction > 0 then DoThis else exit;
164 | // end;
165 | Result := False;
166 | S:=LowerCase(aLine);
167 | if (Pos(';', ALine) > 0)
168 | or (Pos('if ', S) > 0)
169 | or (Pos('begin', S) > 0)
170 | or (Pos('end', S) > 0)
171 | or (Pos('then', S) > 0)
172 | or (Pos('else', ALine) > 0)
173 | or (Pos('and', ALine) > 0)
174 | or (Pos('or', ALine) > 0)
175 | or (Pos('//', ALine) > 0)
176 | then Result := True;
177 | end;
178 |
179 |
180 | // This function inverts all Assignments operation.
181 | // like valuea := valueb; to valueb := valuea;
182 | // or valuea := False; to valuea := True;
183 | function TInvertAssignment.InvertAssignment(InText: string): string;
184 | var
185 | InLines : TStringList;
186 | HasLinefeed: Boolean;
187 |
188 | begin
189 | if InText = '' then
190 | Exit('');
191 | HasLinefeed := InText[Length(InText)] in [#10,#13];
192 | InLines := TStringList.Create;
193 | InLines.SkipLastLineBreak:=True;
194 | InLines.Text := InText;
195 | InvertAssignment(InLines);
196 | Result := InLines.Text;
197 | InLines.Free;
198 | if not HasLinefeed then begin
199 | while Result[Length(Result)] in [#10,#13] do
200 | SetLength(Result, Length(Result)-1);
201 | end;
202 | end;
203 |
204 | procedure TInvertAssignment.InvertAssignment(Lines: TStrings);
205 |
206 | var
207 | TempLines: TStringList;
208 | PreList, AList, BList, PostList: TStrings;
209 | ALine: String;
210 | Indents: array of integer;
211 | X, Y, EqPos: Integer;
212 |
213 |
214 | begin
215 | PreList:=Nil;
216 | AList:=Nil;
217 | BList:=Nil;
218 | PostList:=Nil;
219 | TempLines:=nil;
220 | Indents:=Nil;
221 | try
222 | SetLength(Indents, Lines.Count);
223 | TempLines := TStringList.Create;
224 |
225 | // Join many lines to one
226 | ALine := '';
227 | for X := 0 to Lines.Count-1 do begin
228 | ALine := ALine + Lines[X];
229 | if IsAWholeLine(ALine) then begin
230 | Indents[TempLines.Add(ALine)] := GetIndent(ALine);
231 | ALine := '';
232 | end;
233 | end;
234 | if Length(ALine) > 0 then
235 | Indents[TempLines.Add(ALine)] := GetIndent(ALine);
236 |
237 | Lines.Clear;
238 | PreList := TStringList.Create;
239 | AList := TStringList.Create;
240 | BList := TStringList.Create;
241 | PostList := TStringList.Create;
242 |
243 | DivideLines(TempLines, PreList, AList, BList, PostList);
244 |
245 | // Find where the ':=' should be
246 | EqPos := 0;
247 | for X := 0 to BList.Count-1 do begin
248 | Y := Length(BList[X]);
249 | if Y > EqPos then
250 | EqPos := Y;
251 | end;
252 |
253 | for X := 0 to AList.Count-1 do
254 | Lines.Add(InvertLine(PreList[X],Alist[X],BList[X],PostList[X],Indents[X],EqPos));
255 |
256 | finally
257 | PreList.Free;
258 | AList.Free;
259 | BList.Free;
260 | PostList.Free;
261 | TempLines.Free;
262 | end;
263 | end;
264 |
265 | end.
266 |
267 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.References.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.References;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | { RTL }
28 | SysUtils, Classes,
29 | { Code Tools }
30 | CodeToolManager, CodeCache, CTUnitGraph,
31 | { LazUtils }
32 | LazFileUtils, Laz_AVL_Tree,
33 | { Protocol }
34 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.General, LSP.Messages, LSP.References;
35 |
36 | Type
37 | { TReferencesRequest }
38 |
39 | { The references request is sent from the client to the server to resolve
40 | project-wide references for the symbol denoted by the given text document position. }
41 |
42 | TReferencesRequest = class(specialize TLSPRequest)
43 | procedure FindReferences(Filename, MainFilename: String; X, Y: Integer; Items: TLocationItems);
44 | function Process(var Params: TReferenceParams): TLocationItems; override;
45 | end;
46 |
47 |
48 | implementation
49 |
50 | uses
51 | PasLS.Settings, PasLS.Diagnostics;
52 |
53 | procedure TReferencesRequest.FindReferences(Filename, MainFilename: String; X, Y: Integer; Items: TLocationItems);
54 | var
55 | DeclCode, StartSrcCode, Code: TCodeBuffer;
56 | ListOfPCodeXYPosition: TFPList;
57 | DeclX, DeclY, DeclTopLine, i: Integer;
58 | Identifier: string;
59 | Graph: TUsesGraph;
60 | Cache: TFindIdentifierReferenceCache;
61 | TreeOfPCodeXYPosition: Laz_AVL_Tree.TAVLTree;
62 | ANode, Node: Laz_AVL_Tree.TAVLTreeNode;
63 | CodePos: PCodeXYPosition;
64 | Files: TStringList;
65 | Completed: boolean;
66 | UGUnit: TUGUnit;
67 | Loc: TLocationItem;
68 | begin
69 |
70 | // Step 1: load the file
71 | StartSrcCode:=CodeToolBoss.LoadFile(Filename,false,false);
72 |
73 | // Step 2: find the main declaration
74 | if not CodeToolBoss.FindMainDeclaration(StartSrcCode,
75 | X,Y,
76 | DeclCode,DeclX,DeclY,DeclTopLine) then
77 | begin
78 | PublishCodeToolsError(Transport,'FindMainDeclaration failed in '+StartSrcCode.FileName+' at '+IntToStr(Y)+':'+IntToStr(X));
79 | ExitCode:=-1;
80 | exit;
81 | end;
82 |
83 | // Step 3: get identifier
84 | CodeToolBoss.GetIdentifierAt(DeclCode,DeclX,DeclY,Identifier);
85 | DoLog('Found identifier: %s',[Identifier]);
86 |
87 | // Step 4: collect all modules of program
88 | Files:=TStringList.Create;
89 | ListOfPCodeXYPosition:=nil;
90 | TreeOfPCodeXYPosition:=nil;
91 | Cache:=nil;
92 | try
93 | Files.Add(DeclCode.Filename);
94 | if CompareFilenames(DeclCode.Filename,StartSrcCode.Filename)<>0 then
95 | Files.Add(DeclCode.Filename);
96 |
97 | // parse all used units
98 | Graph:=CodeToolBoss.CreateUsesGraph;
99 | try
100 | Graph.AddStartUnit(MainFilename);
101 | Graph.AddTargetUnit(DeclCode.Filename);
102 | Graph.Parse(true,Completed);
103 | Node:=Laz_AVL_Tree.TAVLTreeNode(Graph.FilesTree.FindLowest); // here explicitly casting the return
104 | while Node<>nil do begin
105 | UGUnit:=TUGUnit(Node.Data);
106 | Files.Add(UGUnit.Filename);
107 | Node:=Laz_AVL_Tree.TAVLTreeNode(Node.Successor); // same, casting return explicitly
108 | end;
109 | finally
110 | Graph.Free;
111 | end;
112 |
113 | // Step 5: find references in all files
114 | for i:=0 to Files.Count-1 do begin
115 | DoLog('Searching "%s"...',[Files[i]]);
116 | Code:=CodeToolBoss.LoadFile(Files[i],true,false);
117 | if Code=nil then begin
118 | DoLog('unable to load "%s"',[Files[i]]);
119 | continue;
120 | end;
121 | // search references
122 | CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
123 | if not CodeToolBoss.FindReferences(
124 | DeclCode,DeclX,DeclY,
125 | Code, true, ListOfPCodeXYPosition, Cache) then
126 | begin
127 | PublishCodeToolsError(Transport,'FindReferences failed in "'+Code.Filename+'"');
128 | continue;
129 | end;
130 | if ListOfPCodeXYPosition=nil then continue;
131 | // In order to show all references after any parser error, they are
132 | // collected in a tree
133 | if TreeOfPCodeXYPosition=nil then
134 | TreeOfPCodeXYPosition:=Laz_AVL_Tree.TAVLTree(CodeToolBoss.CreateTreeOfPCodeXYPosition);
135 | CodeToolBoss.AddListToTreeOfPCodeXYPosition(ListOfPCodeXYPosition,
136 | TreeOfPCodeXYPosition,true,false);
137 | end;
138 |
139 | // Step 6: show references
140 | if TreeOfPCodeXYPosition=nil then begin
141 | // No references found
142 | exit;
143 | end;
144 | ANode:=Laz_AVL_Tree.TAVLTreeNode(TreeOfPCodeXYPosition.FindHighest);
145 | while ANode<>nil do begin
146 | CodePos:=PCodeXYPosition(ANode.Data);
147 | Loc := Items.Add;
148 | Loc.URI := PathToURI(CodePos^.Code.Filename);
149 | Loc.Range.SetRange(CodePos^.Y - 1, CodePos^.X - 1);
150 | { With CodePos^ do
151 | DoLog('Found: %s @ %d,%d', [Code.Filename, Y,X]);}
152 | ANode:=Laz_AVL_Tree.TAVLTreeNode(TreeOfPCodeXYPosition.FindPrecessor(ANode));
153 | end;
154 |
155 | finally
156 | Files.Free;
157 | CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
158 | CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
159 | Cache.Free;
160 | end;
161 | end;
162 |
163 | { TReferencesRequest }
164 |
165 | function TReferencesRequest.Process(var Params: TReferenceParams): TLocationItems;
166 | var
167 | Path: String;
168 | X, Y: Integer;
169 |
170 | begin with Params do
171 | begin
172 | Path := textDocument.LocalPath;
173 | X := position.character;
174 | Y := position.line;
175 |
176 | Result := TLocationItems.Create;
177 | // if the main program file was provided via initializationOptions -> program
178 | // then use this unit as the root for searching, otherwise default to the
179 | // current text document
180 | if ServerSettings.&program <> '' then
181 | FindReferences(Path, ServerSettings.&program, X + 1, Y + 1, Result)
182 | else
183 | FindReferences(Path, Path, X + 1, Y + 1, Result);
184 | end;
185 | end;
186 |
187 | end.
188 |
189 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.RemoveEmptyMethods.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.RemoveEmptyMethods;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes, SysUtils,
28 | { Codetools }
29 | CodeToolManager, CodeCache,
30 | { LSP }
31 | LSP.Messages, LSP.Basic, LSP.Base;
32 |
33 | Type
34 |
35 | { TRemoveEmptyMethods }
36 |
37 | TRemoveEmptyMethods = Class(TObject)
38 | private
39 | FTransport: TMessageTransport;
40 | Public
41 | Constructor Create(aTransport : TMessageTransport);
42 | Procedure Execute(const aDocumentURI : String; aPosition: TPosition); virtual;
43 | Property Transport : TMessageTransport Read FTransport;
44 | end;
45 |
46 | implementation
47 |
48 | uses
49 | { codetools }
50 | PascalParserTool, CodeToolsStructs,
51 | { LSP }
52 | PasLS.ApplyEdit;
53 |
54 | { TRemoveEmptyMethods }
55 |
56 | constructor TRemoveEmptyMethods.Create(aTransport: TMessageTransport);
57 | begin
58 | FTransport:=aTransport;
59 | end;
60 |
61 | procedure TRemoveEmptyMethods.Execute(const aDocumentURI: String;
62 | aPosition: TPosition);
63 |
64 | Const
65 | Attributes =
66 | [phpAddClassName,phpDoNotAddSemicolon,phpWithoutParamList,
67 | phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon];
68 |
69 | var
70 | aList : TFPList;
71 | allEmpty : Boolean;
72 | aX,aY : Integer;
73 | Msg : String;
74 | RemovedProcHeads: TStrings;
75 | Code : TCodeBuffer;
76 | aRange : TRange;
77 |
78 | begin
79 | Code:=CodeToolBoss.FindFile(URIToPath(aDocumentUri));
80 | if Code=Nil then
81 | begin
82 | Transport.SendDiagnostic('Cannot find file %s',[aDocumentURI]);
83 | exit;
84 | end;
85 | aY:=aPosition.line+1;
86 | aX:=aPosition.character+1;
87 | RemovedProcHeads:=Nil;
88 | aList:=TFPList.Create;
89 | try
90 | // check whether cursor is in a class
91 | if not CodeToolBoss.FindEmptyMethods(Code,'',aX,aY,AllPascalClassSections,aList,AllEmpty) then
92 | begin
93 | Msg:=CodeToolBoss.ErrorMessage;
94 | if Msg='' then
95 | Msg:='No class at caret position';
96 | Transport.SendDiagnostic('Cannot find empty methods in file %s: %s',[aDocumentURI,Msg]);
97 | exit;
98 | end;
99 | if not CodeToolBoss.RemoveEmptyMethods(Code,'',aX,aY,AllPascalClassSections,AllEmpty, Attributes, RemovedProcHeads) then
100 | Transport.SendDiagnostic('Failed to remove empty methods in file %s',[aDocumentURI])
101 | else
102 | begin
103 | aRange := TRange.Create(0, 0, MaxInt, MaxInt);
104 | try
105 | DoApplyEdit(Transport,aDocumentURI, Code.Source, aRange);
106 | finally
107 | aRange.Free;
108 | end;
109 | end;
110 | finally
111 | CodeToolBoss.FreeListOfPCodeXYPosition(aList);
112 | RemovedProcHeads.Free;
113 | end;
114 | end;
115 |
116 |
117 |
118 | end.
119 |
120 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.SignatureHelp.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.SignatureHelp;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL }
27 | Classes,
28 | { Code Tools }
29 | CodeToolManager, CodeCache, IdentCompletionTool,
30 | { Protocol }
31 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.SignatureHelp;
32 |
33 | Type
34 | { TSignatureHelpRequest
35 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_signatureHelp
36 |
37 | Signature help represents the signature of something
38 | callable. There can be multiple signature but only one
39 | active and only one active parameter. }
40 |
41 | TSignatureHelpRequest = class(specialize TLSPRequest)
42 | function Process(var Params: TTextDocumentPositionParams): TSignatureHelp; override;
43 | end;
44 |
45 |
46 | implementation
47 |
48 | uses
49 | { RTL }
50 | SysUtils, PasLS.CodeUtils,
51 | { Code Tools}
52 | FindDeclarationTool, CodeTree, PascalParserTool,
53 | { Protocol }
54 | PasLS.Diagnostics;
55 |
56 |
57 | { TSignatureHelpRequest }
58 |
59 | function TSignatureHelpRequest.Process(var Params: TTextDocumentPositionParams): TSignatureHelp;
60 |
61 | procedure ExtractProcParts(CurContext: TCodeContextInfoItem; out Code: String; out ParamList: TStringList);
62 | var
63 | Params, ResultType: String;
64 | CurExprType: TExpressionType;
65 | CodeNode: TCodeTreeNode;
66 | CodeTool: TFindDeclarationTool;
67 | i: integer;
68 | begin
69 | ParamList := nil;
70 | CurExprType := CurContext.Expr;
71 | Code := ExpressionTypeDescNames[CurExprType.Desc];
72 | if CurExprType.Context.Node <> nil then
73 | begin
74 | CodeNode := CurExprType.Context.Node;
75 | CodeTool := CurExprType.Context.Tool;
76 | case CodeNode.Desc of
77 | ctnProcedure:
78 | begin
79 | ResultType := CodeTool.ExtractProcHead(CodeNode, [
80 | phpWithoutClassName, // skip classname
81 | phpWithoutName, // skip function name
82 | phpWithoutGenericParams,// skip <> after proc name
83 | phpWithoutParamList, // skip param list
84 | phpWithoutParamTypes, // skip colon, param types and default values
85 | phpWithoutBrackets, // skip start- and end-bracket of parameter list
86 | phpWithoutSemicolon, // skip semicolon at end
87 | phpWithResultType]);
88 |
89 | Params := CodeTool.ExtractProcHead(CodeNode,
90 | [phpWithoutName,
91 | phpWithoutBrackets,
92 | phpWithoutSemicolon,
93 | phpWithVarModifiers,
94 | phpWithParameterNames,
95 | phpWithDefaultValues]);
96 |
97 | if Params <> '' then
98 | begin
99 | ParamList := ParseParamList(Params);
100 | // rebuild the param list into a single string
101 | Params := '(';
102 | for i := 0 to ParamList.Count - 1 do
103 | begin
104 | Params += ParamList[i];
105 | if I < ParamList.Count - 1 then
106 | Params += '; ';
107 | end;
108 | Params += ')';
109 | end;
110 |
111 | Code := Params+ResultType;
112 | end;
113 | end;
114 | end;
115 | end;
116 |
117 | var
118 |
119 | Code: TCodeBuffer;
120 | X, Y, I, ItemIndex: Integer;
121 | CodeContext: TCodeContextInfo;
122 | Item: TCodeContextInfoItem;
123 | Signature: TSignatureInformation;
124 |
125 | Parameter: TParameterInformation;
126 | Head: String;
127 | ParamList: TStringList;
128 | begin
129 | Result:=Nil;
130 | with Params do
131 | begin
132 | Code := CodeToolBoss.FindFile(URIToPath(textDocument.uri));
133 | X := position.character;
134 | Y := position.line;
135 | CodeContext := nil;
136 | try
137 | if not CodeToolBoss.FindCodeContext(Code, X + 1, Y + 1, CodeContext) or (CodeContext = nil) or (CodeContext.Count = 0) then
138 | begin
139 | PublishCodeToolsError(Transport,'');
140 | exit(nil);
141 | end;
142 |
143 | Result := TSignatureHelp.Create;
144 |
145 | // TODO: how do we know which one is active given the current parameters?
146 | Result.activeSignature := 0;
147 |
148 | for ItemIndex := 0 to CodeContext.Count - 1 do
149 | begin
150 | Item := CodeContext[ItemIndex];
151 | ExtractProcParts(Item, Head, ParamList);
152 |
153 | Signature := Result.signatures.Add;
154 | Signature.&label := CodeContext.ProcName+Head;
155 |
156 | if ParamList <> nil then
157 | begin
158 | for I := 0 to ParamList.Count - 1 do
159 | begin
160 | Parameter := Signature.Parameters.Add;
161 | Parameter.&label := ParamList[I];
162 | end;
163 | ParamList.Free;
164 | end;
165 | end;
166 |
167 | Result.activeParameter := CodeContext.ParameterIndex - 1;
168 | except
169 | on E: Exception do
170 | begin
171 | Transport.SendDiagnostic('Signature Error: %s %s',[E.ClassName,E.Message]);
172 | end;
173 | end;
174 |
175 | FreeAndNil(CodeContext);
176 | end;
177 | end;
178 |
179 | end.
180 |
181 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Synchronization.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Arjan Adriaanse
3 | // Copyright 2020 Ryan Joseph
4 |
5 | // This file is part of Pascal Language Server.
6 |
7 | // Pascal Language Server is free software: you can redistribute it
8 | // and/or modify it under the terms of the GNU General Public License
9 | // as published by the Free Software Foundation, either version 3 of
10 | // the License, or (at your option) any later version.
11 |
12 | // Pascal Language Server is distributed in the hope that it will be
13 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
14 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 | // GNU General Public License for more details.
16 |
17 | // You should have received a copy of the GNU General Public License
18 | // along with Pascal Language Server. If not, see
19 | // .
20 | unit PasLS.Synchronization;
21 |
22 | {$mode objfpc}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | Classes, DateUtils,
28 | CodeToolManager, CodeCache,
29 | LSP.BaseTypes, LSP.Base, LSP.Basic, PasLS.Symbols, LSP.Synchronization;
30 |
31 | Type
32 | { TDidOpenTextDocument }
33 |
34 | TDidOpenTextDocument = class(specialize TLSPNotification)
35 | procedure Process(var Params : TDidOpenTextDocumentParams); override;
36 | end;
37 |
38 | { TDidSaveTextDocument }
39 |
40 | TDidSaveTextDocument = class(specialize TLSPNotification)
41 | procedure Process(var Params : TDidSaveTextDocumentParams); override;
42 | end;
43 |
44 |
45 | { TDidCloseTextDocument }
46 |
47 | TDidCloseTextDocument = class(specialize TLSPNotification)
48 | procedure Process(var Params : TDidCloseTextDocumentParams); override;
49 | end;
50 | { TDidChangeTextDocument }
51 |
52 | TDidChangeTextDocument = class(specialize TLSPNotification)
53 | procedure Process(var Params : TDidChangeTextDocumentParams); override;
54 | end;
55 |
56 |
57 | implementation
58 |
59 | uses PasLS.CheckInactiveRegions, PasLS.Diagnostics;
60 |
61 | { TDidChangeTextDocument }
62 |
63 | procedure TDidChangeTextDocument.Process(var Params : TDidChangeTextDocumentParams);
64 | var
65 | Code: TCodeBuffer;
66 | Change: TCollectionItem;
67 | { Range: TRange;
68 | StartPos, EndPos: integer;}
69 |
70 |
71 | begin with Params do
72 | begin
73 | Code := CodeToolBoss.FindFile(textDocument.LocalPath);
74 | for Change in contentChanges do
75 | begin
76 | // note(ryan): can't get this working yet
77 | // and I'm not even sure if it's worth it
78 | {
79 | Range := TTextDocumentContentChangeEvent(Change).range;
80 | if Range <> nil then
81 | begin
82 | //Code.LineColToPosition(Range.start.line + 1, Range.start.character + 1, StartPos);
83 | //Code.LineColToPosition(Range.&end.line + 1, Range.&end.character + 1, EndPos);
84 | DoLog('insert: %d -> %d text=%s',[StartPos,EndPos, TTextDocumentContentChangeEvent(Change).text]);
85 | //Code.Replace(StartPos, EndPos - StartPos, TTextDocumentContentChangeEvent(Change).text);
86 | end
87 | else }
88 | Code.Source := TTextDocumentContentChangeEvent(Change).text;
89 |
90 | // Ryan, uncomment this to have a syntax check at
91 | // CheckSyntax(Self.Transport,Code);
92 |
93 | //if SymbolManager <> nil then
94 | // SymbolManager.FileModified(Code);
95 | end;
96 | // DoLog( 'Synched text in %d ms',[MilliSecondsBetween(Now, StartTime)]);
97 | end;
98 | end;
99 |
100 | { TDidCloseTextDocument }
101 |
102 | procedure TDidCloseTextDocument.Process(var Params : TDidCloseTextDocumentParams);
103 |
104 |
105 | begin with Params do
106 | begin
107 | // URI := ParseURI(textDocument.uri);
108 | // TODO: clear errors
109 | // TODO: if the file was manually loaded (i.e. not in search paths)
110 | // then we may want to remove it from the symbol table so it doesn't cause clutter
111 | end;
112 | end;
113 |
114 |
115 | { TDidSaveTextDocument }
116 |
117 | procedure TDidSaveTextDocument.Process(var Params : TDidSaveTextDocumentParams);
118 | var
119 | Code: TCodeBuffer;
120 | begin
121 |
122 | Code := CodeToolBoss.FindFile(Params.textDocument.LocalPath);
123 | if SymbolManager <> nil then
124 | SymbolManager.FileModified(Code);
125 | DiagnosticsHandler.CheckSyntax(Transport,Code);
126 | CheckInactiveRegions(Transport, Code, Params.textDocument.uri);
127 | // ClearDiagnostics(Transport,Code);
128 |
129 | end;
130 |
131 |
132 | { TDidOpenTextDocument }
133 |
134 | procedure TDidOpenTextDocument.Process(var Params : TDidOpenTextDocumentParams);
135 | var
136 |
137 | Path: String;
138 | Code: TCodeBuffer;
139 | begin with Params do
140 | begin
141 | Path := textDocument.LocalPath;
142 |
143 | Code := CodeToolBoss.FindFile(Path);
144 | if Code <> nil then
145 | Code.Source := textDocument.text;
146 |
147 | // the file was not found in search paths so
148 | // it need to be loaded from disk
149 | if Code = nil then
150 | Code := CodeToolBoss.LoadFile(Path, False, False);
151 |
152 | DiagnosticsHandler.CheckSyntax(Transport,Code);
153 |
154 | CheckInactiveRegions(Transport, Code, textDocument.uri);
155 | //if SymbolManager <> nil then
156 | // SymbolManager.FileModified(Code);
157 | if SymbolManager <> nil then
158 | SymbolManager.Reload(Code, True);
159 | end;
160 | end;
161 |
162 | end.
163 |
164 |
--------------------------------------------------------------------------------
/src/serverprotocol/PasLS.Workspace.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Ryan Joseph
3 |
4 | // This file is part of Pascal Language Server.
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 | unit PasLS.Workspace;
20 |
21 | {$mode objfpc}{$H+}
22 |
23 | interface
24 |
25 | uses
26 | { RTL}
27 | Classes, SysUtils, fpJSON,
28 | { LSP Protocol }
29 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.General, LSP.DocumentSymbol, fpjsonrpc,
30 | PasLS.Settings, PasLS.Symbols, LSP.Streaming, LSP.Workspace;
31 |
32 | Type
33 | { TDidChangeWorkspaceFolders }
34 |
35 | { The workspace/didChangeWorkspaceFolders notification is sent from the client to the server
36 | to inform the server about workspace folder configuration changes. The notification is sent
37 | by default if both client capability workspace.workspaceFolders and the server capability
38 | workspace.workspaceFolders.supported are true; or if the server has registered itself to
39 | receive this notification. To register for the workspace/didChangeWorkspaceFolders send
40 | a client/registerCapability request from the server to the client. The registration parameter
41 | must have a registrations item of the following form, where id is a unique id used to
42 | unregister the capability (the example uses a UUID): }
43 |
44 | TDidChangeWorkspaceFolders = class(specialize TLSPNotification)
45 | procedure Process(var Params : TDidChangeWorkspaceFoldersParams); override;
46 | end;
47 | { TWorkspaceSymbolRequest }
48 |
49 | { The workspace symbol request is sent from the client to the server to
50 | list project-wide symbols matching the query string. }
51 |
52 | TWorkspaceSymbolRequest = class(specialize TLSPRequest)
53 | function DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; override;
54 | end;
55 | { TDidChangeConfiguration }
56 |
57 | { A notification sent from the client to the server to signal the change of configuration settings. }
58 |
59 | TDidChangeConfiguration = class(specialize TLSPNotification)
60 | procedure Process(var Params: TDidChangeConfigurationParams); override;
61 | end;
62 |
63 | { TWorkspaceApplyEditRequest
64 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspace_applyEdit
65 |
66 | The `workspace/applyEdit` request is sent from the server to the client to
67 | modify resource on the client side. }
68 |
69 | TWorkspaceApplyEditRequest = class(specialize TLSPOutgoingRequest);
70 |
71 | implementation
72 |
73 | { TDidChangeWorkspaceFolders }
74 |
75 | procedure TDidChangeWorkspaceFolders.Process(var Params : TDidChangeWorkspaceFoldersParams);
76 | begin
77 | end;
78 |
79 | { TWorkspaceSymbolRequest }
80 |
81 | function TWorkspaceSymbolRequest.DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData;
82 | var
83 | Input: TWorkspaceSymbolParams;
84 |
85 | begin
86 | Input := specialize TLSPStreaming.ToObject(Params);
87 | Result := SymbolManager.FindWorkspaceSymbols(Input.query);
88 | if not Assigned(Result) then
89 | Result := TJSONNull.Create;
90 | end;
91 |
92 | { TDidChangeConfiguration }
93 |
94 | procedure TDidChangeConfiguration.Process(var Params: TDidChangeConfigurationParams);
95 | begin
96 | end;
97 |
98 |
99 | end.
100 |
101 |
--------------------------------------------------------------------------------
/src/serverprotocol/lspserver.lpk:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/serverprotocol/lspserver.pas:
--------------------------------------------------------------------------------
1 | { This file was automatically created by Lazarus. Do not edit!
2 | This source is only used to compile and install the package.
3 | }
4 |
5 | unit lspserver;
6 |
7 | {$warn 5023 off : no warning about unused units}
8 | interface
9 |
10 | uses
11 | PasLS.General, PasLS.References, PasLS.Diagnostics, PasLS.GotoDeclaration,
12 | PasLS.GotoDefinition, PasLS.GotoImplementation, PasLS.Completion,
13 | PasLS.SignatureHelp, PasLS.Synchronization, PasLS.AllCommands,
14 | PasLS.CodeAction, PasLS.DocumentHighlight, PasLS.Hover, PasLS.InlayHint,
15 | PasLS.Workspace, PasLS.ApplyEdit, PasLS.RemoveEmptyMethods,
16 | PasLS.Command.CompleteCode, PasLS.Command.FormatCode,
17 | PasLS.Command.InvertAssignment, PasLS.Command.RemoveEmptyMethods,
18 | PasLS.DocumentSymbol, PasLS.Commands, PasLS.Formatter, PasLS.ExecuteCommand,
19 | PasLS.CodeUtils, PasLS.InvertAssign, PasLS.LazConfig, PasLS.Parser,
20 | PasLS.Symbols, PasLS.CheckInactiveRegions, PasLS.InactiveRegions,
21 | LazarusPackageIntf;
22 |
23 | implementation
24 |
25 | procedure Register;
26 | begin
27 | end;
28 |
29 | initialization
30 | RegisterPackage('lspserver', @Register);
31 | end.
32 |
--------------------------------------------------------------------------------
/src/socketserver/PasLSSock.Config.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // Socket-based protocol server - configuration options
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLSSock.Config;
21 |
22 | {$mode ObjFPC}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | Classes, SysUtils, Inifiles;
28 |
29 | Const
30 | DefaultSocketUnix = '';
31 | DefaultSocketPort = 9898;
32 | DefaultSingleConnect = False;
33 | DefaultThreaded = False;
34 | DefaultLogFile = '';
35 | DefaultCompiler = 'fpc';
36 | DefaultLazarusDir = '';
37 | DefaultFPCDir = '';
38 | DefaultTargetOS = {$i %FPCTARGETOS%};
39 | DefaultTargetCPU = {$i %FPCTARGETCPU%};
40 |
41 | Type
42 | { TLSPSocketServerConfig }
43 |
44 | TLSPSocketServerConfig = Class(TObject)
45 | private
46 | FCompiler: string;
47 | FFPCDir: string;
48 | FLazarusDir: string;
49 | FLogFile: String;
50 | FPort: Word;
51 | FSingleConnect: Boolean;
52 | FTargetCPU: string;
53 | FTargetOS: string;
54 | FThreaded: Boolean;
55 | FUnix: String;
56 | Public
57 | Constructor Create; virtual;
58 | Procedure Reset; virtual;
59 | class Function DefaultConfigFile : String;
60 | Procedure LoadFromFile(const aFileName : String);
61 | Procedure SaveToFile(const aFileName : String);
62 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual;
63 | Procedure SaveToIni(aIni : TCustomIniFile); virtual;
64 | Public
65 | Property Port : Word Read FPort Write FPort;
66 | Property Unix : String Read FUnix Write FUnix;
67 | Property SingleConnect : Boolean Read FSingleConnect Write FSingleConnect;
68 | Property Threaded : Boolean Read FThreaded Write FThreaded;
69 | Property LogFile : String Read FLogFile Write FLogFile;
70 | property Compiler : string read FCompiler write FCompiler;
71 | property FPCDir : string Read FFPCDir Write FFPCDir;
72 | property LazarusDir : string read FLazarusDir write FLazarusDir;
73 | property TargetOS : string read FTargetOS write FTargetOS;
74 | property TargetCPU : string read FTargetCPU write FTargetCPU;
75 | end;
76 |
77 |
78 | implementation
79 |
80 | Const
81 | SServer = 'Server';
82 | KeyPort = 'Port';
83 | KeyUnix = 'Unix';
84 | KeySingleConnect = 'SingleConnect';
85 | KeyThreaded = 'Threaded';
86 | KeyLogFile = 'LogFile';
87 |
88 | SCodeTools = 'CodeTools';
89 | KeyCompiler = 'Compiler';
90 | KeyFPCDir = 'FPCDir';
91 | KeyLazarusDir = 'LazarusDir';
92 | KeyTargetCPU = 'TargetCPU';
93 | KeyTargetOS = 'TargetOS';
94 |
95 | { TLSPSocketServerConfig }
96 |
97 | constructor TLSPSocketServerConfig.Create;
98 | begin
99 | Reset;
100 | end;
101 |
102 | procedure TLSPSocketServerConfig.Reset;
103 | begin
104 | FPort:=DefaultSocketPort;
105 | FUnix:=DefaultSocketUnix;
106 | FSingleConnect:=DefaultSingleConnect;
107 | FThreaded:=DefaultThreaded;
108 | LogFile:=DefaultLogFile;
109 | Compiler:=DefaultCompiler;
110 | FPCDir:=DefaultFPCDir;
111 | LazarusDir:=DefaultLazarusDir;
112 | TargetCPU:=DefaultTargetCPU;
113 | TargetOS:=DefaultTargetOS;
114 | end;
115 |
116 | class function TLSPSocketServerConfig.DefaultConfigFile: String;
117 | begin
118 | {$IFDEF UNIX}
119 | Result:='/etc/paslssock.cfg';
120 | {$ELSE}
121 | Result:=ChangeFileExt(ParamStr(0),'.ini');
122 | {$ENDIF}
123 | end;
124 |
125 | procedure TLSPSocketServerConfig.LoadFromFile(const aFileName: String);
126 |
127 | Var
128 | Ini : TCustomIniFile;
129 |
130 | begin
131 | Ini:=TMemIniFile.Create(aFileName);
132 | try
133 | LoadFromIni(Ini);
134 | finally
135 | Ini.Free;
136 | end;
137 | end;
138 |
139 | procedure TLSPSocketServerConfig.SaveToFile(const aFileName: String);
140 | Var
141 | Ini : TCustomIniFile;
142 |
143 | begin
144 | Ini:=TMemIniFile.Create(aFileName);
145 | try
146 | SaveToIni(Ini);
147 | Ini.UpdateFile;
148 | finally
149 | Ini.Free;
150 | end;
151 | end;
152 |
153 | procedure TLSPSocketServerConfig.LoadFromIni(aIni: TCustomIniFile);
154 | begin
155 | With aIni do
156 | begin
157 | FPort:=ReadInteger(SServer,KeyPort,FPort);
158 | FUnix:=ReadString(SServer,KeyUnix,FUnix);
159 | FSingleConnect:=ReadBool(SServer,KeySingleConnect,SingleConnect);
160 | FThreaded:=ReadBool(SServer,KeyThreaded,Threaded);
161 | FLogFile:=ReadString(SServer,KeyLogFile,LogFile);
162 | Compiler:=ReadString(SCodeTools,KeyCompiler,Compiler);
163 | FPCDir:=ReadString(SCodetools,KeyFPCDir,FPCDir);
164 | LazarusDir:=ReadString(SCodetools,KeyLazarusDir,LazarusDir);
165 | TargetCPU:=ReadString(SCodetools,KeyTargetCPU,TargetCPU);
166 | TargetOS:=ReadString(SCodetools,KeyTargetOS,TargetOS);
167 | end;
168 | end;
169 |
170 | procedure TLSPSocketServerConfig.SaveToIni(aIni: TCustomIniFile);
171 | begin
172 | With aIni do
173 | begin
174 | WriteInteger(SServer,KeyPort,FPort);
175 | WriteString(SServer,KeyUnix,FUnix);
176 | WriteBool(SServer,KeySingleConnect,SingleConnect);
177 | WriteBool(SServer,KeyThreaded,Threaded);
178 | WriteString(SServer,KeyLogFile,LogFile);
179 | WriteString(SCodeTools,KeyCompiler,Compiler);
180 | WriteString(SCodetools,KeyFPCDir,FPCDir);
181 | WriteString(SCodetools,KeyLazarusDir,LazarusDir);
182 | WriteString(SCodetools,KeyTargetCPU,TargetCPU);
183 | WriteString(SCodetools,KeyTargetOS,TargetOS);
184 | end;
185 | end;
186 |
187 |
188 | end.
189 |
190 |
--------------------------------------------------------------------------------
/src/socketserver/paslssock.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/socketserver/paslssock.lpr:
--------------------------------------------------------------------------------
1 | program paslssock;
2 |
3 | // Socket-based Pascal Language Server
4 | // Copyright 2023 Michael Van Canneyt
5 |
6 | // This file is part of Pascal Language Server.
7 |
8 | // Pascal Language Server is free software: you can redistribute it
9 | // and/or modify it under the terms of the GNU General Public License
10 | // as published by the Free Software Foundation, either version 3 of
11 | // the License, or (at your option) any later version.
12 |
13 | // Pascal Language Server is distributed in the hope that it will be
14 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
15 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | // GNU General Public License for more details.
17 |
18 | // You should have received a copy of the GNU General Public License
19 | // along with Pascal Language Server. If not, see
20 | // .
21 |
22 |
23 | {$mode objfpc}{$H+}
24 | {$modeswitch advancedrecords}
25 |
26 | uses
27 | {$IFDEF UNIX}
28 | cthreads, cwstring,
29 | {$ENDIF}
30 | LazLogger,
31 | Classes, SysUtils, CustApp, IniFiles, PasLS.AllCommands, LSP.Messages,
32 | LSP.Base, PasLS.Settings, PasLSSock.Config, PasLS.SocketDispatcher;
33 |
34 | type
35 |
36 | { TPasLSPSocketServerApp }
37 |
38 | TPasLSPSocketServerApp = class(TCustomApplication)
39 | Private
40 | FConfig : TLSPSocketServerConfig;
41 | procedure ConfigureLSP;
42 | procedure DoMessageLog(sender: TObject; const Msg: UTF8String);
43 | function ParseOptions: Boolean;
44 | protected
45 | procedure DoRun; override;
46 | public
47 | constructor Create(TheOwner: TComponent); override;
48 | destructor Destroy; override;
49 | procedure Usage(const aError: String); virtual;
50 | end;
51 |
52 |
53 | { TPasLSPSocketServerApp }
54 |
55 | function TPasLSPSocketServerApp.ParseOptions : Boolean;
56 |
57 | var
58 | FN : String;
59 | begin
60 | Result:=False;
61 | FN:=GetOptionValue('c','config');
62 | if FN='' then
63 | FN:=TLSPSocketServerConfig.DefaultConfigFile;
64 | FConfig.LoadFromFile(FN);
65 | {$IFDEF UNIX}
66 | if HasOption('u','unix') then
67 | FConfig.Unix:=GetOptionValue('u','unix');
68 | {$ENDIF}
69 | if HasOption('p','port') then
70 | FConfig.Port:=StrToInt(GetOptionValue('p','port'));
71 | if HasOption('l','log') then
72 | FConfig.LogFile:=GetOptionValue('l','log');
73 | if HasOption('t','threaded') then
74 | FConfig.Threaded:=True;
75 | if HasOption('s','single-connect') then
76 | FConfig.SingleConnect:=True;
77 | Result:=True;
78 | end;
79 |
80 | procedure TPasLSPSocketServerApp.ConfigureLSP;
81 |
82 | begin
83 | TLSPContext.LogFile:=FConfig.LogFile;
84 | With EnvironmentSettings do
85 | begin
86 | pp:=FConfig.Compiler;
87 | fpcDir:=FConfig.FPCDir;
88 | lazarusDir:=FConfig.LazarusDir;
89 | fpcTarget:=FConfig.TargetOS;
90 | fpcTargetCPU:=FConfig.TargetCPU;
91 | end;
92 | TMessageTransport.OnLog:=@DoMessageLog;
93 | end;
94 |
95 | procedure TPasLSPSocketServerApp.DoMessageLog(sender: TObject;
96 | const Msg: UTF8String);
97 | begin
98 | TLSPContext.Log(Msg);
99 | if Sender<>Nil then;
100 | end;
101 |
102 | procedure TPasLSPSocketServerApp.DoRun;
103 |
104 | Const
105 | ShortOpts = 'hp:u:c:tsl:';
106 | LongOpts : array of string = ('help','port','unix','config','threaded','single-connect','log:');
107 |
108 |
109 | var
110 | ErrorMsg: String;
111 | Disp : TLSPServerSocketDispatcher;
112 |
113 | begin
114 | Terminate;
115 | RegisterAllCommands;
116 | // quick check parameters
117 | ErrorMsg:=CheckOptions(ShortOpts,LongOpts);
118 | if (ErrorMsg<>'') or HasOption('h','help') then
119 | begin
120 | Usage(ErrorMsg);
121 | Exit;
122 | end;
123 | if not ParseOptions then
124 | exit;
125 | ConfigureLSP;
126 | if FConfig.Port>0 then
127 | Disp:=TLSPServerTCPSocketDispatcher.Create(FConfig.Port)
128 | else
129 | Disp:=TLSPServerUnixSocketDispatcher.Create(FConfig.Unix);
130 | Try
131 | Disp.SingleConnect:=FConfig.SingleConnect;
132 | Disp.InitSocket;
133 | Disp.RunLoop;
134 | finally
135 | Disp.Free;
136 | end;
137 | end;
138 |
139 | constructor TPasLSPSocketServerApp.Create(TheOwner: TComponent);
140 | begin
141 | inherited Create(TheOwner);
142 | StopOnException:=True;
143 | FConfig:=TLSPSocketServerConfig.Create;
144 | end;
145 |
146 | destructor TPasLSPSocketServerApp.Destroy;
147 | begin
148 | FConfig.Free;
149 | inherited Destroy;
150 | end;
151 |
152 | procedure TPasLSPSocketServerApp.Usage(const aError : String);
153 | begin
154 | if aError<>'' then
155 | Writeln('Error : ',aError);
156 | Writeln('Usage: ', ExeName, ' [options]');
157 | Writeln('Where options is one or more of:');
158 | Writeln('-h --help This help message');
159 | Writeln('-c --config=FILE Read configuration from file FILE. Default is to read from ',TLSPSocketServerConfig.DefaultConfigFile);
160 | Writeln('-l --log=FILE Set log file in which to write all log messages');
161 | Writeln('-p --port=NNN Listen on port NNN');
162 | Writeln('-s --single-connect Handle one connection and then exit');
163 | Writeln('-t --threaded Use threading for connections.');
164 | Writeln('-u --unix=FILE Listen on unix socket FILE (only on unix-like systems)');
165 | Writeln('Only one of -p or -u may be specified, if none is specified then the default is to listen on port 9898');
166 | ExitCode:=Ord(aError<>'')
167 | end;
168 |
169 | var
170 | Application: TPasLSPSocketServerApp;
171 | Buffer: Array[1..100*1024] of byte;
172 |
173 | begin
174 | Close(Output);
175 | Assign(Output,GetTempDir(false)+'paslssock-out.log');
176 | SetTextBuf(Output,Buffer,SizeOf(Buffer));
177 | Rewrite(output);
178 | Application:=TPasLSPSocketServerApp.Create(nil);
179 | Application.Title:='Pascal LSP socket server application';
180 | Application.Run;
181 | Application.Free;
182 | end.
183 |
184 |
--------------------------------------------------------------------------------
/src/standard/PasLS.LSConfig.pas:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2023 Michael Van Canneyt
3 |
4 | // Socket-based protocol server - configuration options
5 |
6 | // Pascal Language Server is free software: you can redistribute it
7 | // and/or modify it under the terms of the GNU General Public License
8 | // as published by the Free Software Foundation, either version 3 of
9 | // the License, or (at your option) any later version.
10 |
11 | // Pascal Language Server is distributed in the hope that it will be
12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | // GNU General Public License for more details.
15 |
16 | // You should have received a copy of the GNU General Public License
17 | // along with Pascal Language Server. If not, see
18 | // .
19 |
20 | unit PasLS.LSConfig;
21 |
22 | {$mode ObjFPC}{$H+}
23 |
24 | interface
25 |
26 | uses
27 | Classes, SysUtils, Inifiles;
28 |
29 | Const
30 | DefaultLogFile = '';
31 | DefaultCompiler = 'fpc';
32 | DefaultLazarusDir = '';
33 | DefaultFPCDir = '';
34 | DefaultTargetOS = {$i %FPCTARGETOS%};
35 | DefaultTargetCPU = {$i %FPCTARGETCPU%};
36 |
37 | Type
38 | { TLSPServerConfig }
39 |
40 | TLSPServerConfig = Class(TObject)
41 | private
42 | FCompiler: string;
43 | FFPCDir: string;
44 | FLazarusDir: string;
45 | FLogFile: String;
46 | FTargetCPU: string;
47 | FTargetOS: string;
48 | Public
49 | Constructor Create; virtual;
50 | Procedure Reset; virtual;
51 | class Function DefaultConfigFile : String;
52 | Procedure LoadFromFile(const aFileName : String);
53 | Procedure SaveToFile(const aFileName : String);
54 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual;
55 | Procedure SaveToIni(aIni : TCustomIniFile); virtual;
56 | Public
57 | Property LogFile : String Read FLogFile Write FLogFile;
58 | property Compiler : string read FCompiler write FCompiler;
59 | property FPCDir : string Read FFPCDir Write FFPCDir;
60 | property LazarusDir : string read FLazarusDir write FLazarusDir;
61 | property TargetOS : string read FTargetOS write FTargetOS;
62 | property TargetCPU : string read FTargetCPU write FTargetCPU;
63 | end;
64 |
65 |
66 | implementation
67 |
68 | Const
69 | SServer = 'Server';
70 | KeyLogFile = 'LogFile';
71 |
72 | SCodeTools = 'CodeTools';
73 | KeyCompiler = 'Compiler';
74 | KeyFPCDir = 'FPCDir';
75 | KeyLazarusDir = 'LazarusDir';
76 | KeyTargetCPU = 'TargetCPU';
77 | KeyTargetOS = 'TargetOS';
78 |
79 | { TLSPServerConfig }
80 |
81 | constructor TLSPServerConfig.Create;
82 | begin
83 | Reset;
84 | end;
85 |
86 | procedure TLSPServerConfig.Reset;
87 | begin
88 | LogFile:=DefaultLogFile;
89 | Compiler:=DefaultCompiler;
90 | FPCDir:=DefaultFPCDir;
91 | LazarusDir:=DefaultLazarusDir;
92 | TargetCPU:=DefaultTargetCPU;
93 | TargetOS:=DefaultTargetOS;
94 | end;
95 |
96 | class function TLSPServerConfig.DefaultConfigFile: String;
97 | begin
98 | {$IFDEF UNIX}
99 | Result:='/etc/pasls.cfg';
100 | {$ELSE}
101 | Result:=ChangeFileExt(ParamStr(0),'.ini');
102 | {$ENDIF}
103 | end;
104 |
105 | procedure TLSPServerConfig.LoadFromFile(const aFileName: String);
106 |
107 | Var
108 | Ini : TCustomIniFile;
109 |
110 | begin
111 | Ini:=TMemIniFile.Create(aFileName);
112 | try
113 | LoadFromIni(Ini);
114 | finally
115 | Ini.Free;
116 | end;
117 | end;
118 |
119 | procedure TLSPServerConfig.SaveToFile(const aFileName: String);
120 | Var
121 | Ini : TCustomIniFile;
122 |
123 | begin
124 | Ini:=TMemIniFile.Create(aFileName);
125 | try
126 | SaveToIni(Ini);
127 | Ini.UpdateFile;
128 | finally
129 | Ini.Free;
130 | end;
131 | end;
132 |
133 | procedure TLSPServerConfig.LoadFromIni(aIni: TCustomIniFile);
134 | begin
135 | With aIni do
136 | begin
137 | FLogFile:=ReadString(SServer,KeyLogFile,LogFile);
138 | Compiler:=ReadString(SCodeTools,KeyCompiler,Compiler);
139 | FPCDir:=ReadString(SCodetools,KeyFPCDir,FPCDir);
140 | LazarusDir:=ReadString(SCodetools,KeyLazarusDir,LazarusDir);
141 | TargetCPU:=ReadString(SCodetools,KeyTargetCPU,TargetCPU);
142 | TargetOS:=ReadString(SCodetools,KeyTargetOS,TargetOS);
143 | end;
144 | end;
145 |
146 | procedure TLSPServerConfig.SaveToIni(aIni: TCustomIniFile);
147 | begin
148 | With aIni do
149 | begin
150 | WriteString(SServer,KeyLogFile,LogFile);
151 | WriteString(SCodeTools,KeyCompiler,Compiler);
152 | WriteString(SCodetools,KeyFPCDir,FPCDir);
153 | WriteString(SCodetools,KeyLazarusDir,LazarusDir);
154 | WriteString(SCodetools,KeyTargetCPU,TargetCPU);
155 | WriteString(SCodetools,KeyTargetOS,TargetOS);
156 | end;
157 | end;
158 |
159 |
160 | end.
161 |
162 |
--------------------------------------------------------------------------------
/src/standard/pasls.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/standard/pasls.lpr:
--------------------------------------------------------------------------------
1 | // Pascal Language Server
2 | // Copyright 2020 Arjan Adriaanse
3 | // Copyright 2020 Ryan Joseph
4 |
5 | // This file is part of Pascal Language Server.
6 |
7 | // Pascal Language Server is free software: you can redistribute it
8 | // and/or modify it under the terms of the GNU General Public License
9 | // as published by the Free Software Foundation, either version 3 of
10 | // the License, or (at your option) any later version.
11 |
12 | // Pascal Language Server is distributed in the hope that it will be
13 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty
14 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 | // GNU General Public License for more details.
16 |
17 | // You should have received a copy of the GNU General Public License
18 | // along with Pascal Language Server. If not, see
19 | // .
20 |
21 | program pasls;
22 |
23 | {$mode objfpc}{$H+}
24 |
25 | uses
26 | { RTL }
27 |
28 | SysUtils, Classes, FPJson, JSONParser, JSONScanner,
29 | { Protocol }
30 | PasLS.AllCommands, PasLS.Settings,
31 | LSP.Base, LSP.Basic, PasLS.TextLoop, PasLS.LSConfig;
32 |
33 | Type
34 |
35 | { TLSPLogContext }
36 |
37 | TLSPLogContext = Class(TLSPContext)
38 | Public
39 | procedure DoTransportLog(sender : TObject; Const Msg : UTF8String);
40 |
41 | end;
42 |
43 | Function ExecuteCommandLineMessages(aContext : TLSPContext) : Boolean;
44 |
45 | var
46 | i: integer;
47 | method, path : String;
48 |
49 | begin
50 | Result:=True;
51 | if ParamCount=0 then
52 | exit;
53 | if (ParamCount div 2)= 1 then
54 | begin
55 | writeln('Invalid parameter count of '+ParamCount.ToString+' (must be pairs of 2)');
56 | Exit(false);
57 | end;
58 | TLSPContext.Log('Command-line Message loop');
59 | I:=1;
60 | while i <= ParamCount do
61 | begin
62 | method := ParamStr(i);
63 | path := ExpandFileName(ParamStr(i + 1));
64 | if not FileExists(path) then
65 | begin
66 | writeln('Command path "',path,'" can''t be found');
67 | exit(false)
68 | end;
69 | DebugSendMessage(output,aContext, method, GetFileAsString(path));
70 | Inc(i, 2);
71 | end;
72 | end;
73 |
74 | Procedure ConfigEnvironment(aConfig : TLSPServerConfig);
75 |
76 | begin
77 | With EnvironmentSettings do
78 | begin
79 | pp:=aConfig.Compiler;
80 | fpcDir:=aConfig.FPCDir;
81 | lazarusDir:=aConfig.LazarusDir;
82 | fpcTarget:=aConfig.TargetOS;
83 | fpcTargetCPU:=aConfig.TargetCPU;
84 | end;
85 | end;
86 |
87 | var
88 | aTransport: TLSPTextTransport;
89 | aContext: TLSPLogContext;
90 | aDisp: TLSPLocalDispatcher;
91 | aCfg: TLSPServerConfig;
92 |
93 | { TLSPLogContext }
94 |
95 | procedure TLSPLogContext.DoTransportLog(sender: TObject; const Msg: UTF8String);
96 | begin
97 | Log('Transport log: '+Msg);
98 | end;
99 |
100 |
101 | begin
102 | // Show help for the server
103 | if ParamStr(1) = '-h' then
104 | begin
105 | writeln('Pascal Language Server [',{$INCLUDE %DATE%},']');
106 | Halt;
107 | end;
108 | aContext := nil;
109 | aCfg := TLSPServerConfig.Create;
110 | try
111 | RegisterAllCommands;
112 | aCfg.LoadFromFile(aCfg.DefaultConfigFile);
113 | if aCfg.LogFile<>'' then
114 | TLSPContext.LogFile := aCfg.LogFile;
115 | ConfigEnvironment(aCfg);
116 | SetupTextLoop(Input,Output,StdErr);
117 | aTransport:=TLSPTextTransport.Create(@Output,@StdErr);
118 | aDisp:=TLSPLocalDispatcher.Create(aTransport,True);
119 | aContext:=TLSPLogContext.Create(aTransport,aDisp,True);
120 | aTransport.OnLog := @aContext.DoTransportLog;
121 | if not ExecuteCommandLineMessages(aContext) then
122 | exit;
123 | RunMessageLoop(Input,Output,StdErr,aContext);
124 | Finally
125 | aContext.Free;
126 | aCfg.Free;
127 | end;
128 | end.
129 |
--------------------------------------------------------------------------------
/src/tests/Tests.Basic.pas:
--------------------------------------------------------------------------------
1 | unit Tests.Basic;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils, fpcunit, testutils, testregistry,
9 | LSP.Basic;
10 |
11 | type
12 |
13 | { TTestRange }
14 |
15 | TTestRange= class(TTestCase)
16 | private
17 | FRange: TRange;
18 | procedure SetRange(AValue: TRange);
19 | protected
20 | procedure SetUp; override;
21 | procedure TearDown; override;
22 | Procedure CheckRange(Msg : string; aStartLine,aStartChar,aEndLine,aEndChar : Integer);
23 | // Created in startup, will be freed in teardown.
24 | Property Range : TRange Read FRange Write SetRange;
25 | Public
26 | class Procedure CheckRange(Msg : string; aRange: TRange; aStartLine,aStartChar,aEndLine,aEndChar : Integer);
27 | published
28 | procedure TestHookUp;
29 | procedure TestAssign;
30 | procedure TestConstructorLen;
31 | procedure TestConstructorAllPos;
32 | procedure TestSetRangeLen;
33 | Procedure TestSetRangeAllPos;
34 | Procedure TestToString;
35 | end;
36 |
37 | implementation
38 |
39 | procedure TTestRange.TestHookUp;
40 | begin
41 | AssertNotNull('Have range',Range);
42 | CheckRange('No args in constructor.',0,0,0,0);
43 | end;
44 |
45 | procedure TTestRange.TestAssign;
46 |
47 | Var
48 | B : TRange;
49 |
50 | begin
51 | B:=TRange.Create;
52 | B.Start.line:=12;
53 | B.Start.character:=13;
54 | B.&end.line:=14;
55 | B.&end.character:=15;
56 | try
57 | Range.Assign(B);
58 | finally
59 | b.Free;
60 | end;
61 | CheckRange('Assign',12,13,14,15);
62 | end;
63 |
64 | procedure TTestRange.TestConstructorLen;
65 |
66 | begin
67 | Range:=TRange.Create(10,11,15);
68 | CheckRange('Constructor with pos and length',10,11,10,26);
69 | end;
70 |
71 | procedure TTestRange.TestConstructorAllPos;
72 | begin
73 | Range:=TRange.Create(10,11,12,13);
74 | CheckRange('Constructor with explicit start and end',10,11,12,13);
75 | end;
76 |
77 | procedure TTestRange.TestSetRangeLen;
78 | begin
79 | Range.SetRange(10,11,15);
80 | CheckRange('Setrange with pos and length',10,11,10,26);
81 | end;
82 |
83 | procedure TTestRange.TestSetRangeAllPos;
84 | begin
85 | Range.SetRange(10,11,12,13);
86 | CheckRange('Constructor with explicit start and end',10,11,12,13);
87 | end;
88 |
89 | procedure TTestRange.TestToString;
90 |
91 | Const
92 | aResult = 'start: [10:11], end: [12:13]';
93 |
94 | begin
95 | Range.SetRange(10,11,12,13);
96 | AssertEquals('ToString',aResult,Range.ToString);
97 | end;
98 |
99 | procedure TTestRange.SetRange(AValue: TRange);
100 | begin
101 | if FRange=AValue then Exit;
102 | FreeAndNil(FRange);
103 | FRange:=AValue;
104 | end;
105 |
106 | procedure TTestRange.SetUp;
107 | begin
108 | Range:=TRange.Create;
109 | end;
110 |
111 | procedure TTestRange.TearDown;
112 | begin
113 | FreeAndNil(FRange);
114 | end;
115 |
116 | procedure TTestRange.CheckRange(Msg: string; aStartLine, aStartChar, aEndLine, aEndChar: Integer);
117 | begin
118 | CheckRange(Msg,Range, aStartLine, aStartChar, aEndLine, aEndChar);
119 | end;
120 |
121 | class procedure TTestRange.CheckRange(Msg: string; aRange: TRange; aStartLine,
122 | aStartChar, aEndLine, aEndChar: Integer);
123 | begin
124 | AssertEquals(Msg+': Start line',aStartLine,aRange.Start.line);
125 | AssertEquals(Msg+': Start character',aStartChar,aRange.Start.character);
126 | AssertEquals(Msg+': End line',aEndLine,aRange.&end.line);
127 | AssertEquals(Msg+': End character',aEndChar,aRange.&end.character);
128 | end;
129 |
130 | initialization
131 |
132 | RegisterTest(TTestRange);
133 | end.
134 |
135 |
--------------------------------------------------------------------------------
/src/tests/testlsp.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/src/tests/testlsp.lpr:
--------------------------------------------------------------------------------
1 | program testlsp;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | Classes, consoletestrunner, Tests.Basic;
7 |
8 | type
9 |
10 | { TMyTestRunner }
11 |
12 | TMyTestRunner = class(TTestRunner)
13 | protected
14 | // override the protected methods of TTestRunner to customize its behavior
15 | end;
16 |
17 | var
18 | Application: TMyTestRunner;
19 |
20 | begin
21 | DefaultFormat:=fPlain;
22 | DefaultRunAllTests:=True;
23 | Application := TMyTestRunner.Create(nil);
24 | Application.Initialize;
25 | Application.Title := 'FPCUnit Console test runner';
26 | Application.Run;
27 | Application.Free;
28 | end.
29 |
--------------------------------------------------------------------------------