diff --git a/README.md b/README.md index b015038..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. @@ -98,6 +104,24 @@ 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. + +- `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): Show an error message. This relies on the LSP client (text editor) handling the `window/showMessage` message. Support in various text editor: + + - 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. + ## Roadmap ### Wishlist diff --git a/server/uinitialize.pas b/server/uinitialize.pas index 8ee9775..162c562 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 @@ -532,10 +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; + i: Integer; RootUri: string; Directory: string; @@ -587,7 +598,9 @@ 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 = 'syntaxErrorReportingMode') and Reader.Number(i) then + SyntaxErrorReportingMode := SyntaxErrorReportingModeFromInt(i); end; end; diff --git a/server/ujsonrpc.pas b/server/ujsonrpc.pas index ee6e5db..203cf9d 100644 --- a/server/ujsonrpc.pas +++ b/server/ujsonrpc.pas @@ -49,21 +49,26 @@ TRpcRequest = class destructor Destroy; override; end; - { TRpcResponse } - + { 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 InternalCreate(const Id: TRpcId); procedure Finalize; public Writer: TJsonWriter; constructor Create(Id: TRpcId); constructor CreateError(Id: TRpcId; Code: Integer; const Msg: string); constructor CreateRequest(const Method: string; Id: TRpcId); - destructor Destroy; override; + { 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 @@ -127,10 +132,16 @@ function TRpcRequest.AsString: string; { TRpcResponse } -procedure TRpcResponse.InternalCreate(const Id: TRpcId); +procedure TRpcResponse.InternalCreate; begin + inherited Create; FBuffer := TMemoryStream.Create; Writer := TJsonWriter.Create(FBuffer); +end; + +procedure TRpcResponse.InternalCreateId(const Id: TRpcId); +begin + InternalCreate; Writer.Dict; Writer.Key('jsonrpc'); Writer.Str('2.0'); @@ -140,7 +151,7 @@ procedure TRpcResponse.InternalCreate(const Id: TRpcId); constructor TRpcResponse.Create(Id: TRpcId); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('result'); end; @@ -148,7 +159,7 @@ constructor TRpcResponse.CreateError( Id: TRpcId; Code: Integer; const Msg: string ); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('error'); Writer.Dict; @@ -162,11 +173,27 @@ constructor TRpcResponse.CreateError( constructor TRpcResponse.CreateRequest(const Method: string; Id: TRpcId); begin - InternalCreate(Id); + InternalCreateId(Id); Writer.Key('method'); Writer.Str(Method); end; +constructor TRpcResponse.CreateNotification(const Method: string); +begin + InternalCreate; + Writer.Dict; + Writer.Key('jsonrpc'); + Writer.Str('2.0'); + Writer.Key('method'); + Writer.Str(Method); +end; + +destructor TRpcResponse.Destroy; +begin + FreeAndNil(Writer); + FreeAndNil(FBuffer); + inherited; +end; procedure TRpcResponse.Finalize; begin @@ -181,12 +208,6 @@ function TRpcResponse.AsString: string; Move(PByte(FBuffer.Memory)^, Result[1], FBuffer.Size); end; -destructor TRpcResponse.Destroy; -begin - FreeAndNil(Writer); - FreeAndNil(FBuffer); -end; - { TRpcPeer } constructor TRpcPeer.Create(Input: TStream; Output: TStream); @@ -295,7 +316,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 diff --git a/server/utextdocument.pas b/server/utextdocument.pas index 3c69522..7e0f56c 100644 --- a/server/utextdocument.pas +++ b/server/utextdocument.pas @@ -27,6 +27,16 @@ interface uses jsonstream, ujsonrpc; +type + TSyntaxErrorReportingMode = ( + sermShowMessage = 0, + sermFakeCompletionItem = 1, + sermErrorResponse = 2 + ); + +var + SyntaxErrorReportingMode: TSyntaxErrorReportingMode = sermShowMessage; + procedure TextDocument_DidOpen(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_DidChange(Rpc: TRpcPeer; Request: TRpcRequest); procedure TextDocument_SignatureHelp(Rpc: TRpcPeer; Request: TRpcRequest); @@ -313,6 +323,89 @@ function GetPrefix(Code: TCodeBuffer; X, Y: integer): string; end; 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; + MessageNotification: TRpcResponse; + begin + 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 Req: TCompletionRequest; Code: TCodeBuffer; @@ -355,28 +448,19 @@ 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; - //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); end; end;