Allow to report syntax errors using LSP error and/or "window/showMessage" notification

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

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;
 

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,15 +151,15 @@ procedure TRpcResponse.InternalCreate(const Id: TRpcId);
 
 constructor TRpcResponse.Create(Id: TRpcId);
 begin
-  InternalCreate(Id);
+  InternalCreateId(Id);
   Writer.Key('result');
 end;
 
 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

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;