From 14020f80d9cd093745022d0f2c7cde1a42f233e0 Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Mon, 14 Nov 2022 03:49:00 +0100 Subject: [PATCH 1/6] Remove accidental double assignment of Result.Reader --- server/ujsonrpc.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/server/ujsonrpc.pas b/server/ujsonrpc.pas index ee6e5db..d17b88f 100644 --- a/server/ujsonrpc.pas +++ b/server/ujsonrpc.pas @@ -295,7 +295,6 @@ function TRpcPeer.Receive: TRpcRequest; Result.Id := Id; Result.Reader := Reader; Result.FBuffer := Buffer; - Result.Reader := Reader; DebugLog('> Request: '#10'%s', [Copy(Result.AsString, 1, 2000)]); except From 87aba773c777963ed5cf9de3baca712d97d325dc Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Mon, 14 Nov 2022 03:56:35 +0100 Subject: [PATCH 2/6] Options to report syntax errors using LSP error and/or window/showMessage Also, fixed the fake completion item: needs isIncomplete for Emacs to not raise Lisp errors. --- README.md | 20 ++++++++++ server/uinitialize.pas | 9 ++++- server/ujsonrpc.pas | 84 +++++++++++++++++++++++++++++++--------- server/utextdocument.pas | 81 ++++++++++++++++++++++++++++---------- 4 files changed, 153 insertions(+), 41 deletions(-) diff --git a/README.md b/README.md index b015038..dd2e4bf 100644 --- a/README.md +++ b/README.md @@ -98,6 +98,26 @@ following ways: This overrides environment variables. +## Extra configuration in LSP initialization options + +Additional keys in LSP initialization options can be used to influence the LSP server behavior. See the docs of your LSP client (text editor) to know how to pass initialization options. + +- `syntaxErrorCausesLspError` (boolean, behaves as `false` if not specified) : Report LSP error on syntax error when parsing Pascal file. + + By default, when this is `false`, the LSP server answers with a fake completion item with the error message. While it is a hack (we use completion item label to pass the error message), it works in VS Code and NeoVim. + + When this is `true`, the LSP server answers with LSP error. This is visible in Emacs. + +- `syntaxErrorCausesShowMessage` (boolean, behaves as `true` if not specified) : Report a "show message" to LSP client on syntax error when parsing Pascal file. + + Note that this is independent from `syntaxErrorCausesLspError`. Regardless `syntaxErrorCausesLspError` (whether we respond with LSP error or fake item), we can also invoke a "show message" on LSP client. + + The effect of this depends on how the LSP client respects the `window/showMessage`. + + - VS Code shows it nicely. + + - Emacs shows it (but poorly, it will be quickly obscured by the message about lack of completions, and you will need to go to the `*Messages*` buffer to read it). + ## Roadmap ### Wishlist diff --git a/server/uinitialize.pas b/server/uinitialize.pas index 8ee9775..7e18893 100644 --- a/server/uinitialize.pas +++ b/server/uinitialize.pas @@ -34,7 +34,7 @@ implementation uses SysUtils, Classes, CodeToolManager, CodeToolsConfig, URIParser, LazUTF8, DefineTemplates, FileUtil, LazFileUtils, DOM, XMLRead, udebug, uutils, - upackages; + upackages, utextdocument; // Resolve the dependencies of Pkg, and then the dependencies of the @@ -536,6 +536,7 @@ procedure Initialize(Rpc: TRpcPeer; Request: TRpcRequest); Options: TCodeToolsOptions; Key: string; s: string; + b: Boolean; RootUri: string; Directory: string; @@ -587,7 +588,11 @@ procedure Initialize(Rpc: TRpcPeer; Request: TRpcRequest); else if (Key = 'FPCTARGET') and Reader.Str(s) then Options.TargetOS := s else if (Key = 'FPCTARGETCPU') and Reader.Str(s) then - Options.TargetProcessor := s; + Options.TargetProcessor := s + else if (Key = 'syntaxErrorCausesLspError') and Reader.Bool(b) then + SyntaxErrorCausesLspError := b + else if (Key = 'syntaxErrorCausesShowMessage') and Reader.Bool(b) then + SyntaxErrorCausesShowMessage := b; end; end; diff --git a/server/ujsonrpc.pas b/server/ujsonrpc.pas index d17b88f..fd09244 100644 --- a/server/ujsonrpc.pas +++ b/server/ujsonrpc.pas @@ -49,21 +49,40 @@ TRpcRequest = class destructor Destroy; override; end; - { TRpcResponse } - - TRpcResponse = class + { Common ancestor for sending messages to client (responses or notifications). } + TRpcMessageToClient = class protected FBuffer: TMemoryStream; FFinalized: Boolean; - procedure InternalCreate(const Id: TRpcId); - procedure Finalize; + procedure Finalize; virtual; abstract; public Writer: TJsonWriter; + constructor Create; + function AsString: string; + destructor Destroy; override; + end; + + { Send response to client request. } + TRpcResponse = class(TRpcMessageToClient) + protected + procedure InternalCreate(const Id: TRpcId); + procedure Finalize; override; + public constructor Create(Id: TRpcId); constructor CreateError(Id: TRpcId; Code: Integer; const Msg: string); constructor CreateRequest(const Method: string; Id: TRpcId); - destructor Destroy; override; - function AsString: string; + end; + + { Send notifications, like window/showMessage. + + Note that notifications, following json-rpc (ver 2), do not have "id" + and the other side does not reply to them (see https://www.jsonrpc.org/specification#notification ). + That is also why we didn't overuse TRpcResponse for notifications, they deserve special class. } + TRpcNotification = class(TRpcMessageToClient) + protected + procedure Finalize; override; + public + constructor Create(const Method: String); end; TRpcPeer = class @@ -74,7 +93,7 @@ TRpcPeer = class constructor Create(Input: TStream; Output: TStream); function Receive: TRpcRequest; - procedure Send(Response: TRpcResponse); + procedure Send(Response: TRpcMessageToClient); end; { ERpcException } @@ -125,12 +144,33 @@ function TRpcRequest.AsString: string; Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); end; -{ TRpcResponse } +{ TRpcMessageToClient } -procedure TRpcResponse.InternalCreate(const Id: TRpcId); +constructor TRpcMessageToClient.Create; begin + inherited; FBuffer := TMemoryStream.Create; Writer := TJsonWriter.Create(FBuffer); +end; + +function TRpcMessageToClient.AsString: string; +begin + SetLength(Result, FBuffer.Size); + Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); +end; + +destructor TRpcMessageToClient.Destroy; +begin + FreeAndNil(Writer); + FreeAndNil(FBuffer); + inherited; +end; + +{ TRpcResponse } + +procedure TRpcResponse.InternalCreate(const Id: TRpcId); +begin + inherited Create; Writer.Dict; Writer.Key('jsonrpc'); Writer.Str('2.0'); @@ -167,24 +207,30 @@ constructor TRpcResponse.CreateRequest(const Method: string; Id: TRpcId); Writer.Str(Method); end; - procedure TRpcResponse.Finalize; begin if not FFinalized then - Writer.DictEnd; + Writer.DictEnd; // finish the outer-most dictionary started in TRpcResponse.InternalCreate FFinalized := true; end; -function TRpcResponse.AsString: string; +{ TRpcNotification } + +constructor TRpcNotification.Create(const Method: String); begin - SetLength(Result, FBuffer.Size); - Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); + inherited Create; + Writer.Dict; + Writer.Key('jsonrpc'); + Writer.Str('2.0'); + Writer.Key('method'); + Writer.Str(Method); end; -destructor TRpcResponse.Destroy; +procedure TRpcNotification.Finalize; begin - FreeAndNil(Writer); - FreeAndNil(FBuffer); + if not FFinalized then + Writer.DictEnd; // finish the outer-most dictionary started in TRpcNotification.Create + FFinalized := true; end; { TRpcPeer } @@ -304,7 +350,7 @@ function TRpcPeer.Receive: TRpcRequest; end; end; -procedure TRpcPeer.Send(Response: TRpcResponse); +procedure TRpcPeer.Send(Response: TRpcMessageToClient); const ContentType: string = 'application/vscode-jsonrpc; charset=utf-8'; procedure WriteString(const S: string); diff --git a/server/utextdocument.pas b/server/utextdocument.pas index 3c69522..70a34f9 100644 --- a/server/utextdocument.pas +++ b/server/utextdocument.pas @@ -27,6 +27,10 @@ interface uses jsonstream, ujsonrpc; +var + SyntaxErrorCausesLspError: Boolean; + SyntaxErrorCausesShowMessage: Boolean = true; + procedure TextDocument_DidOpen(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_DidChange(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_SignatureHelp(Rpc: TRpcPeer; Request: TRpcRequest); @@ -313,6 +317,23 @@ function GetPrefix(Code: TCodeBuffer; X, Y: integer): string; end; procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); + + function ShowErrorMessage(const ErrorMessage: String): TRpcNotification; + var + Writer: TJsonWriter; + begin + Result := TRpcNotification.Create('window/showMessage'); + Writer := Result.Writer; + + Writer.Key('params'); + Writer.Dict; + Writer.Key('type'); + Writer.Number(1); // type = 1 means "error" + Writer.Key('message'); + Writer.Str(ErrorMessage); + Writer.DictEnd; + end; + var Req: TCompletionRequest; Code: TCodeBuffer; @@ -355,29 +376,49 @@ procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); except on E: ERpcError do begin - // Unfortunately, there isn't really a good way to report errors to the - // client. While there are error responses, those aren't shown to the - // user. There is also the call window/showMessage, but this one is not - // implemented by NeoVim. So we work around it by showing a fake - // completion item. FreeAndNil(Response); - Response := TRpcResponse.Create(Request.Id); - Writer := Response.Writer; - Writer.Dict; - Writer.Key('items'); - Writer.List; - Writer.Dict; - Writer.Key('label'); - Writer.Str(e.Message); - Writer.Key('insertText'); - Writer.Str(''); - Writer.DictEnd; - Writer.ListEnd; + + if SyntaxErrorCausesLspError then + begin + Response := TRpcResponse.CreateError(Request.Id, 0, E.Message); + end else + begin + Response := TRpcResponse.Create(Request.Id); + Writer := Response.Writer; + + Writer.Dict; + { Note that isIncomplete value is required. + See spec: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#completionList + Emacs actually throws Lisp errors when it is missing. } + Writer.Key('isIncomplete'); + Writer.Bool(true); + + Writer.Key('items'); + Writer.List; + + // Unfortunately, there isn't really a good way to report errors to the + // client. While there are error responses, those aren't shown to the + // user. There is also the call window/showMessage, but this one is not + // implemented by NeoVim. So we work around it by showing a fake + // completion item. + Writer.Dict; + Writer.Key('label'); + Writer.Str(e.Message); + Writer.Key('insertText'); + Writer.Str(''); + Writer.DictEnd; + + Writer.ListEnd; + + //Writer.Key('activeParameter'); + //Writer.Key('activeSignature'); + Writer.DictEnd; + end; - //Writer.Key('activeParameter'); - //Writer.Key('activeSignature'); - Writer.DictEnd; Rpc.Send(Response); + + if SyntaxErrorCausesShowMessage then + Rpc.Send(ShowErrorMessage(E.Message)); end; end; finally From af10d8141a94d186efd6276385e403ca7cfb4e09 Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Mon, 14 Nov 2022 22:22:34 +0100 Subject: [PATCH 3/6] One class TRpcResponse with multiple constructors is simpler, fix memory leak at ShowErrorMessage --- server/ujsonrpc.pas | 103 +++++++++++++++------------------------ server/utextdocument.pas | 33 ++++++++----- 2 files changed, 59 insertions(+), 77 deletions(-) diff --git a/server/ujsonrpc.pas b/server/ujsonrpc.pas index fd09244..203cf9d 100644 --- a/server/ujsonrpc.pas +++ b/server/ujsonrpc.pas @@ -49,40 +49,26 @@ TRpcRequest = class destructor Destroy; override; end; - { Common ancestor for sending messages to client (responses or notifications). } - TRpcMessageToClient = class + { Send message to LSP client (response to a previous request or notification). } + TRpcResponse = class + private + procedure InternalCreate; + procedure InternalCreateId(const Id: TRpcId); protected FBuffer: TMemoryStream; FFinalized: Boolean; - procedure Finalize; virtual; abstract; + procedure Finalize; public Writer: TJsonWriter; - constructor Create; - function AsString: string; - destructor Destroy; override; - end; - - { Send response to client request. } - TRpcResponse = class(TRpcMessageToClient) - protected - procedure InternalCreate(const Id: TRpcId); - procedure Finalize; override; - public constructor Create(Id: TRpcId); constructor CreateError(Id: TRpcId; Code: Integer; const Msg: string); constructor CreateRequest(const Method: string; Id: TRpcId); - end; - - { Send notifications, like window/showMessage. - - Note that notifications, following json-rpc (ver 2), do not have "id" - and the other side does not reply to them (see https://www.jsonrpc.org/specification#notification ). - That is also why we didn't overuse TRpcResponse for notifications, they deserve special class. } - TRpcNotification = class(TRpcMessageToClient) - protected - procedure Finalize; override; - public - constructor Create(const Method: String); + { Create JSON-RPC notification. + Note that notifications, following json-rpc (ver 2), do not have "id" + and the other side does not reply to them (see https://www.jsonrpc.org/specification#notification ). } + constructor CreateNotification(const Method: string); + function AsString: string; + destructor Destroy; override; end; TRpcPeer = class @@ -93,7 +79,7 @@ TRpcPeer = class constructor Create(Input: TStream; Output: TStream); function Receive: TRpcRequest; - procedure Send(Response: TRpcMessageToClient); + procedure Send(Response: TRpcResponse); end; { ERpcException } @@ -144,33 +130,18 @@ function TRpcRequest.AsString: string; Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); end; -{ TRpcMessageToClient } +{ TRpcResponse } -constructor TRpcMessageToClient.Create; +procedure TRpcResponse.InternalCreate; begin - inherited; + inherited Create; FBuffer := TMemoryStream.Create; Writer := TJsonWriter.Create(FBuffer); end; -function TRpcMessageToClient.AsString: string; -begin - SetLength(Result, FBuffer.Size); - Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); -end; - -destructor TRpcMessageToClient.Destroy; -begin - FreeAndNil(Writer); - FreeAndNil(FBuffer); - inherited; -end; - -{ TRpcResponse } - -procedure TRpcResponse.InternalCreate(const Id: TRpcId); +procedure TRpcResponse.InternalCreateId(const Id: TRpcId); begin - inherited Create; + InternalCreate; Writer.Dict; Writer.Key('jsonrpc'); Writer.Str('2.0'); @@ -180,7 +151,7 @@ procedure TRpcResponse.InternalCreate(const Id: TRpcId); constructor TRpcResponse.Create(Id: TRpcId); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('result'); end; @@ -188,7 +159,7 @@ constructor TRpcResponse.CreateError( Id: TRpcId; Code: Integer; const Msg: string ); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('error'); Writer.Dict; @@ -202,23 +173,14 @@ constructor TRpcResponse.CreateError( constructor TRpcResponse.CreateRequest(const Method: string; Id: TRpcId); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('method'); Writer.Str(Method); end; -procedure TRpcResponse.Finalize; +constructor TRpcResponse.CreateNotification(const Method: string); begin - if not FFinalized then - Writer.DictEnd; // finish the outer-most dictionary started in TRpcResponse.InternalCreate - FFinalized := true; -end; - -{ TRpcNotification } - -constructor TRpcNotification.Create(const Method: String); -begin - inherited Create; + InternalCreate; Writer.Dict; Writer.Key('jsonrpc'); Writer.Str('2.0'); @@ -226,13 +188,26 @@ constructor TRpcNotification.Create(const Method: String); Writer.Str(Method); end; -procedure TRpcNotification.Finalize; +destructor TRpcResponse.Destroy; +begin + FreeAndNil(Writer); + FreeAndNil(FBuffer); + inherited; +end; + +procedure TRpcResponse.Finalize; begin if not FFinalized then - Writer.DictEnd; // finish the outer-most dictionary started in TRpcNotification.Create + Writer.DictEnd; FFinalized := true; end; +function TRpcResponse.AsString: string; +begin + SetLength(Result, FBuffer.Size); + Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); +end; + { TRpcPeer } constructor TRpcPeer.Create(Input: TStream; Output: TStream); @@ -350,7 +325,7 @@ function TRpcPeer.Receive: TRpcRequest; end; end; -procedure TRpcPeer.Send(Response: TRpcMessageToClient); +procedure TRpcPeer.Send(Response: TRpcResponse); const ContentType: string = 'application/vscode-jsonrpc; charset=utf-8'; procedure WriteString(const S: string); diff --git a/server/utextdocument.pas b/server/utextdocument.pas index 70a34f9..dca26ee 100644 --- a/server/utextdocument.pas +++ b/server/utextdocument.pas @@ -318,20 +318,27 @@ function GetPrefix(Code: TCodeBuffer; X, Y: integer): string; procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); - function ShowErrorMessage(const ErrorMessage: String): TRpcNotification; + procedure ShowErrorMessage(const ErrorMessage: String); var - Writer: TJsonWriter; + Writer: TJsonWriter; + MessageNotification: TRpcResponse; begin - Result := TRpcNotification.Create('window/showMessage'); - Writer := Result.Writer; - - Writer.Key('params'); - Writer.Dict; - Writer.Key('type'); - Writer.Number(1); // type = 1 means "error" - Writer.Key('message'); - Writer.Str(ErrorMessage); - Writer.DictEnd; + MessageNotification := TRpcResponse.CreateNotification('window/showMessage'); + try + Writer := MessageNotification.Writer; + + Writer.Key('params'); + Writer.Dict; + Writer.Key('type'); + Writer.Number(1); // type = 1 means "error" + Writer.Key('message'); + Writer.Str(ErrorMessage); + Writer.DictEnd; + + Rpc.Send(MessageNotification); + finally + FreeAndNil(MessageNotification); + end; end; var @@ -418,7 +425,7 @@ procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); Rpc.Send(Response); if SyntaxErrorCausesShowMessage then - Rpc.Send(ShowErrorMessage(E.Message)); + ShowErrorMessage(E.Message); end; end; finally From ebac7d252fa97d7e6cd2c3746483ebd5db21d13b Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Wed, 16 Nov 2022 04:02:01 +0100 Subject: [PATCH 4/6] Error reporting determined by one simple enum syntaxErrorReportingMode --- README.md | 16 ++---- server/uinitialize.pas | 18 ++++-- server/utextdocument.pas | 118 +++++++++++++++++++++++++-------------- 3 files changed, 94 insertions(+), 58 deletions(-) diff --git a/README.md b/README.md index dd2e4bf..5378aaf 100644 --- a/README.md +++ b/README.md @@ -102,21 +102,13 @@ following ways: Additional keys in LSP initialization options can be used to influence the LSP server behavior. See the docs of your LSP client (text editor) to know how to pass initialization options. -- `syntaxErrorCausesLspError` (boolean, behaves as `false` if not specified) : Report LSP error on syntax error when parsing Pascal file. +- `syntaxErrorReportingMode` (integer): Determines how to report syntax errors. Syntax errors indicate that CodeTools cannot understand the surrounding Pascal code well enough to provide any code completion. - By default, when this is `false`, the LSP server answers with a fake completion item with the error message. While it is a hack (we use completion item label to pass the error message), it works in VS Code and NeoVim. + - 0 (default): Return a fake completion item with the error message. This works well in VC Code and NeoVim -- while the completion item doesn't really complete anything, but the error message is clearly visible. - When this is `true`, the LSP server answers with LSP error. This is visible in Emacs. + - 1: Show an error message. This relies on the LSP client (text editor) handling the `window/showMessage` message. This works well in VS Code, and somewhat works in Emacs (Emacs `lsp-mode` handles and shows the message, though it will usually be quickly hidden by the next message _"No completion item"_ and you'll have to look at it in the `*Messages*` buffer). -- `syntaxErrorCausesShowMessage` (boolean, behaves as `true` if not specified) : Report a "show message" to LSP client on syntax error when parsing Pascal file. - - Note that this is independent from `syntaxErrorCausesLspError`. Regardless `syntaxErrorCausesLspError` (whether we respond with LSP error or fake item), we can also invoke a "show message" on LSP client. - - The effect of this depends on how the LSP client respects the `window/showMessage`. - - - VS Code shows it nicely. - - - Emacs shows it (but poorly, it will be quickly obscured by the message about lack of completions, and you will need to go to the `*Messages*` buffer to read it). + - 2: Return an error to the LSP client. Some LSP clients will just hide the error, but some (like Emacs) will show it clearly and prominently. ## Roadmap diff --git a/server/uinitialize.pas b/server/uinitialize.pas index 7e18893..162c562 100644 --- a/server/uinitialize.pas +++ b/server/uinitialize.pas @@ -532,11 +532,21 @@ procedure GuessCodeToolConfig(Options: TCodeToolsOptions); end; procedure Initialize(Rpc: TRpcPeer; Request: TRpcRequest); + + function SyntaxErrorReportingModeFromInt(const I: Integer): TSyntaxErrorReportingMode; + begin + if (I < Ord(Low(TSyntaxErrorReportingMode))) or + (I > Ord(High(TSyntaxErrorReportingMode))) then + raise Exception.CreateFmt('Invalid syntaxErrorReportingMode: %d, ignoring', [I]); + + Result := TSyntaxErrorReportingMode(I) + end; + var Options: TCodeToolsOptions; Key: string; s: string; - b: Boolean; + i: Integer; RootUri: string; Directory: string; @@ -589,10 +599,8 @@ procedure Initialize(Rpc: TRpcPeer; Request: TRpcRequest); Options.TargetOS := s else if (Key = 'FPCTARGETCPU') and Reader.Str(s) then Options.TargetProcessor := s - else if (Key = 'syntaxErrorCausesLspError') and Reader.Bool(b) then - SyntaxErrorCausesLspError := b - else if (Key = 'syntaxErrorCausesShowMessage') and Reader.Bool(b) then - SyntaxErrorCausesShowMessage := b; + else if (Key = 'syntaxErrorReportingMode') and Reader.Number(i) then + SyntaxErrorReportingMode := SyntaxErrorReportingModeFromInt(i); end; end; diff --git a/server/utextdocument.pas b/server/utextdocument.pas index dca26ee..e388854 100644 --- a/server/utextdocument.pas +++ b/server/utextdocument.pas @@ -27,9 +27,15 @@ interface uses jsonstream, ujsonrpc; +type + TSyntaxErrorReportingMode = ( + sermFakeCompletionItem = 0, + sermShowMessage = 1, + sermErrorResponse = 2 + ); + var - SyntaxErrorCausesLspError: Boolean; - SyntaxErrorCausesShowMessage: Boolean = true; + SyntaxErrorReportingMode: TSyntaxErrorReportingMode = sermFakeCompletionItem; procedure TextDocument_DidOpen(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_DidChange(Rpc: TRpcPeer; Request: TRpcRequest); @@ -318,6 +324,65 @@ function GetPrefix(Code: TCodeBuffer; X, Y: integer): string; procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); + { Create TRpcResponse with fake completion item, just to show ErrorMessage to user. } + function CreateResponseFakeCompletionItem(const ErrorMessage: String): TRpcResponse; + var + Writer: TJsonWriter; + begin + Result := TRpcResponse.Create(Request.Id); + Writer := Result.Writer; + + Writer.Dict; + { Note that isIncomplete value is required. + See spec: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#completionList + Emacs actually throws Lisp errors when it is missing. } + Writer.Key('isIncomplete'); + Writer.Bool(false); + + Writer.Key('items'); + Writer.List; + + // Unfortunately, there isn't really a good way to report errors to the + // client. While there are error responses, those aren't shown to the + // user. There is also the call window/showMessage, but this one is not + // implemented by NeoVim. So we work around it by showing a fake + // completion item. + Writer.Dict; + Writer.Key('label'); + Writer.Str(ErrorMessage); + Writer.Key('insertText'); + Writer.Str(''); + Writer.DictEnd; + + Writer.ListEnd; + + //Writer.Key('activeParameter'); + //Writer.Key('activeSignature'); + Writer.DictEnd; + end; + + { Create TRpcResponse with no completions. } + function CreateResponseNoCompletions: TRpcResponse; + var + Writer: TJsonWriter; + begin + Result := TRpcResponse.Create(Request.Id); + Writer := Result.Writer; + + Writer.Dict; + Writer.Key('isIncomplete'); + Writer.Bool(false); // the list is complete, we will not return more completions if you continue typing + + Writer.Key('items'); + Writer.List; + Writer.ListEnd; + Writer.DictEnd; + end; + + { Send a notification using LSP "window/showMessage". + Internally it will create and destroy a necessary TRpcResponse instance. + Remember that sending "window/showMessage" is *not* a response to LSP request for completions, + so you still need to send something else as completion response. } procedure ShowErrorMessage(const ErrorMessage: String); var Writer: TJsonWriter; @@ -384,48 +449,19 @@ procedure TextDocument_Completion(Rpc: TRpcPeer; Request: TRpcRequest); on E: ERpcError do begin FreeAndNil(Response); - - if SyntaxErrorCausesLspError then - begin - Response := TRpcResponse.CreateError(Request.Id, 0, E.Message); - end else - begin - Response := TRpcResponse.Create(Request.Id); - Writer := Response.Writer; - Writer.Dict; - { Note that isIncomplete value is required. - See spec: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#completionList - Emacs actually throws Lisp errors when it is missing. } - Writer.Key('isIncomplete'); - Writer.Bool(true); - - Writer.Key('items'); - Writer.List; - - // Unfortunately, there isn't really a good way to report errors to the - // client. While there are error responses, those aren't shown to the - // user. There is also the call window/showMessage, but this one is not - // implemented by NeoVim. So we work around it by showing a fake - // completion item. - Writer.Dict; - Writer.Key('label'); - Writer.Str(e.Message); - Writer.Key('insertText'); - Writer.Str(''); - Writer.DictEnd; - - Writer.ListEnd; - - //Writer.Key('activeParameter'); - //Writer.Key('activeSignature'); - Writer.DictEnd; + case SyntaxErrorReportingMode of + sermFakeCompletionItem: + Response := CreateResponseFakeCompletionItem(E.Message); + sermShowMessage: + begin + Response := CreateResponseNoCompletions; + ShowErrorMessage(E.Message); + end; + sermErrorResponse: + Response := TRpcResponse.CreateError(Request.Id, 0, E.Message); end; - Rpc.Send(Response); - - if SyntaxErrorCausesShowMessage then - ShowErrorMessage(E.Message); end; end; finally From 7f8eba3eb2cb0bb4571c18a186e7b41625ad7cac Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Wed, 16 Nov 2022 22:02:06 +0100 Subject: [PATCH 5/6] Make sermShowMessage default, update docs about it, also change order to make it first -- to have best looking docs about it --- README.md | 10 ++++++++-- server/utextdocument.pas | 6 +++--- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index 5378aaf..27dc857 100644 --- a/README.md +++ b/README.md @@ -104,9 +104,15 @@ Additional keys in LSP initialization options can be used to influence the LSP s - `syntaxErrorReportingMode` (integer): Determines how to report syntax errors. Syntax errors indicate that CodeTools cannot understand the surrounding Pascal code well enough to provide any code completion. - - 0 (default): Return a fake completion item with the error message. This works well in VC Code and NeoVim -- while the completion item doesn't really complete anything, but the error message is clearly visible. + - 0 (default): Show an error message. This relies on the LSP client (text editor) handling the `window/showMessage` message. Support in various text editor: - - 1: Show an error message. This relies on the LSP client (text editor) handling the `window/showMessage` message. This works well in VS Code, and somewhat works in Emacs (Emacs `lsp-mode` handles and shows the message, though it will usually be quickly hidden by the next message _"No completion item"_ and you'll have to look at it in the `*Messages*` buffer). + - VS Code: works. + + - NeoVim (0.8.0): works, the message is shown for ~1 sec by default. + + - Emacs: works, the message is visible in [echo area](https://www.emacswiki.org/emacs/EchoArea) and the `*Messages*` buffer. You can filter out useless `No completion found` messages to make it perfect, see https://github.com/michaliskambi/elisp/blob/master/lsp/kambi-pascal-lsp.el for example. + + - 1: Return a fake completion item with the error message. This works well in VC Code and NeoVim -- while the completion item doesn't really complete anything, but the error message is clearly visible. - 2: Return an error to the LSP client. Some LSP clients will just hide the error, but some (like Emacs) will show it clearly and prominently. diff --git a/server/utextdocument.pas b/server/utextdocument.pas index e388854..7e0f56c 100644 --- a/server/utextdocument.pas +++ b/server/utextdocument.pas @@ -29,13 +29,13 @@ interface type TSyntaxErrorReportingMode = ( - sermFakeCompletionItem = 0, - sermShowMessage = 1, + sermShowMessage = 0, + sermFakeCompletionItem = 1, sermErrorResponse = 2 ); var - SyntaxErrorReportingMode: TSyntaxErrorReportingMode = sermFakeCompletionItem; + SyntaxErrorReportingMode: TSyntaxErrorReportingMode = sermShowMessage; procedure TextDocument_DidOpen(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_DidChange(Rpc: TRpcPeer; Request: TRpcRequest); From 2f2e780bfa29a2630e906296f2cb533925f6d5b1 Mon Sep 17 00:00:00 2001 From: Michalis Kamburelis Date: Wed, 16 Nov 2022 22:12:15 +0100 Subject: [PATCH 6/6] Added some notes about Emacs and VS Code --- README.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 27dc857..a31368a 100644 --- a/README.md +++ b/README.md @@ -47,7 +47,13 @@ For information on how to use the server from Neovim, see [client/nvim](client/n To use the server from `lsp-mode` in Emacs, install the separate [`lsp-pascal`](https://github.com/arjanadriaanse/lsp-pascal) module. -(Disclaimer: I don't maintain this and have not tested it as I don't use Emacs) +Full example setup of it is documented in [Michalis notes about LSP + Pascal](https://github.com/michaliskambi/elisp/tree/master/lsp). + +### VS Code + +Install the VS Code extension from https://github.com/genericptr/pasls-vscode . + +Note that the extension settings expose some additional LSP options not understood by this LSP server. But the basic ones (FPC, Lazarus configs and the executable of LSP server) work completely fine with this LSP server. ### Other Any editor that allows you to add custom LSP configurations should work.