Merge remote branch 'origin/master' into edge

(no-precommit-check no-tn-check)

Author: mergerepo

doc/source_dirs.md

@@ -0,0 +1,26 @@
+# Source dirs
+
+## Short introduction
+
+This is a custom request used by the VS Code extension to retrieve the project's source directories, allowing to add missing directories in the workspace when needed.
+
+## Change description
+
+We introduce three new types to represent the request parameters and results:
+
+```typescript
+
+interface ALS_Unit_Description {
+   name       : string; /* The source directory's name in VS Code */
+   uri : DocumentUri;   /* The source directory's uri */
+}
+```
+
+And a new request:
+
+  method: `workspace/alsSourceDirs`
+  params: null
+
+Returning the source directories of the loaded project like this:
+
+  result: `ALS_Source_Dir_Description[]`

integration/vscode/ada/src/extension.ts

@@ -24,12 +24,12 @@ import {
     ServerOptions,
 } from 'vscode-languageclient/node';
 import * as process from 'process';
-
 import GPRTaskProvider from './gprTaskProvider';
 import cleanTaskProvider from './cleanTaskProvider';
 import gnatproveTaskProvider from './gnatproveTaskProvider';
 import { alsCommandExecutor } from './alsExecuteCommand';
 import { ALSClientFeatures } from './alsClientFeatures';
+import { string } from 'fp-ts';
 
 let alsTaskProvider: vscode.Disposable[] = [
     vscode.tasks.registerTaskProvider(GPRTaskProvider.gprBuildType, new GPRTaskProvider()),
@@ -125,6 +125,60 @@ export function activate(context: vscode.ExtensionContext): void {
 
     context.subscriptions.push(vscode.workspace.onDidChangeConfiguration(configChanged));
     context.subscriptions.push(vscode.commands.registerCommand('ada.otherFile', otherFileHandler));
+
+    //  Check if we need to add some source directories to the workspace (e.g: when imported projects'
+    //  source directories are not placed under the root project's directory).
+    client.onReady().then(() => {
+        client.sendRequest("workspace/alsSourceDirs").then(
+            data => {
+                const source_dirs = JSON.parse(JSON.stringify(data));
+                const workspace_folders = vscode.workspace.workspaceFolders ?? []
+                let workspace_dirs_to_add: { uri: vscode.Uri, name?: string | undefined}[] = []
+
+                for (var source_dir of source_dirs) {
+                    const source_dir_uri = vscode.Uri.parse(source_dir.uri)
+                    let source_dir_path = source_dir_uri.path
+                    let workspace_folder_path = workspace_folders[0].uri.path
+
+                    function is_subdirectory(dir: string, parent: string) {
+                        //  Use lower-case on Windows since drives can be specified in VS Code either
+                        //  with lower or upper case characters.
+                        if (process.platform == "win32") {
+                            dir = dir.toLowerCase();
+                            parent = parent.toLowerCase();
+                        }
+
+                        return dir.startsWith(parent + '/');
+
+                    }
+
+                    //  If the source directory is not under one of the workspace folders, push this
+                    //  source directory to the workspace folders to add later.
+                    if (!workspace_folders.some(workspace_folder =>
+                        is_subdirectory(source_dir_path, workspace_folder.uri.path))) {
+                        workspace_dirs_to_add.push({name: source_dir.name, uri: source_dir_uri});
+                    }
+                }
+
+                //  If there are some source directories missing in the workspace, ask the user
+                //  to add them in his workspace.
+                if (workspace_dirs_to_add.length > 0) {
+                    vscode.window
+                        .showInformationMessage("Some project source directories are not "
+                            + "listed in your workspace: do you want to add them?", "Yes", "No")
+                        .then(answer => {
+                            if (answer === "Yes") {
+                                for (var workspace_dir of workspace_dirs_to_add) {
+                                  vscode.workspace.updateWorkspaceFolders(
+                                        vscode.workspace.workspaceFolders ? vscode.workspace.workspaceFolders.length : 0, null,
+                                        workspace_dir);
+                                    }
+                            }
+                        })
+                }
+            }
+        )
+    })
 }
 
 export function deactivate(): void {

scripts/generate.py

@@ -322,6 +322,9 @@
     ('textDocument/alsShowDependencies', 'ALS_Show_Dependencies',
      'ALS_ShowDependenciesParams',
      'ALS_ShowDependencies_Response'),
+    ('workspace/alsSourceDirs', 'ALS_Source_Dirs',
+     None,
+     'ALS_SourceDirs_Response'),
     ('$/alsDebug', 'ALS_Debug', 'ALSDebugParams', 'ALS_Debug_Response'),
     ('$/alsCheckSyntax', 'ALS_Check_Syntax', 'ALS_Check_Syntax_Params',
      'ALS_Check_Syntax_Response'),

source/ada/lsp-ada_context_sets.adb

@@ -158,12 +158,16 @@ package body LSP.Ada_Context_Sets is
    ----------------------------
 
    function All_Source_Directories
-     (Self : Context_Set'Class) return GNATCOLL.VFS.File_Array
+     (Self                     : Context_Set'Class;
+      Include_Externally_Built : Boolean := False)
+      return GNATCOLL.VFS.File_Array
    is
       Consolidated_Set : LSP.Ada_File_Sets.File_Sets.Set;
    begin
       for C of Self.Contexts loop
-         Consolidated_Set.Union (C.List_Source_Directories);
+         Consolidated_Set.Union
+           (C.List_Source_Directories
+              (Include_Externally_Built => Include_Externally_Built));
       end loop;
 
       declare

source/ada/lsp-ada_context_sets.ads

@@ -59,10 +59,13 @@ package LSP.Ada_Context_Sets is
    --  Number of files in all contexts
 
    function All_Source_Directories
-     (Self : Context_Set'Class) return GNATCOLL.VFS.File_Array;
-   --  Return the list of all source directories for writable projects
-   --  in the context (ie, excluding externally-built projects). Each
-   --  dirctory is present only once in the resulting array.
+     (Self                     : Context_Set'Class;
+      Include_Externally_Built : Boolean := False)
+      return GNATCOLL.VFS.File_Array;
+   --  Return the list of all source directories for writable projects in the
+   --  context, including externally built projects' source directories when
+   --  Include_Externally_Built is set to True.
+   --  Each dirctory is present only once in the resulting array.
 
    procedure Cleanup (Self : in out Context_Set'Class);
    --  Free memory referenced by Self

source/ada/lsp-ada_contexts.adb

@@ -237,9 +237,15 @@ package body LSP.Ada_Contexts is
    -----------------------------
 
    function List_Source_Directories
-     (Self : Context) return LSP.Ada_File_Sets.File_Sets.Set is
+     (Self                     : Context;
+      Include_Externally_Built : Boolean := False)
+      return LSP.Ada_File_Sets.File_Sets.Set is
    begin
-      return Self.Source_Dirs;
+      if Include_Externally_Built then
+         return Self.External_Source_Dirs;
+      else
+         return Self.Source_Dirs;
+      end if;
    end List_Source_Directories;
 
    -------------------------
@@ -651,13 +657,23 @@ package body LSP.Ada_Contexts is
          end loop;
 
          Self.Source_Dirs.Clear;
+         Self.External_Source_Dirs.Clear;
+
          for Dir of Source_Dirs
            (Project                  => Root,
             Recursive                => True,
             Include_Externally_Built => False)
          loop
             Self.Source_Dirs.Include (Dir);
          end loop;
+
+         for Dir of Source_Dirs
+           (Project                  => Root,
+            Recursive                => True,
+            Include_Externally_Built => True)
+         loop
+            Self.External_Source_Dirs.Include (Dir);
+         end loop;
       end Update_Source_Files;
 
       --------------------------

source/ada/lsp-ada_contexts.ads

@@ -205,8 +205,11 @@ package LSP.Ada_Contexts is
    --  Return the analysis units for all Ada sources known to this context
 
    function List_Source_Directories
-     (Self : Context) return LSP.Ada_File_Sets.File_Sets.Set;
-   --  List the source directories in non-externally-built projects
+     (Self                     : Context;
+      Include_Externally_Built : Boolean := False)
+      return LSP.Ada_File_Sets.File_Sets.Set;
+   --  List the source directories, including externally built projects' source
+   --  directories when Include_Externally_Built is set to True.
 
    function Get_AU
      (Self    : Context;
@@ -307,6 +310,9 @@ private
       --  All the source dirs in the loaded project, not including
       --  the externally built projects
 
+      External_Source_Dirs : LSP.Ada_File_Sets.File_Sets.Set;
+      --  All the source dirs coming from externally built projects
+
       PP_Options : Utils.Command_Lines.Command_Line
                     (Pp.Command_Lines.Descriptor'Access);
       --  Object to keep gnatpp options

source/ada/lsp-ada_handlers.adb

@@ -3160,9 +3160,40 @@ package body LSP.Ada_Handlers is
       return Response;
    end On_References_Request;
 
-   ----------------------------------
+   --------------------------------
+   -- On_ALS_Source_Dirs_Request --
+   --------------------------------
+
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Message_Handler;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+   is
+      Response : LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+        (Is_Error => False);
+      Unit_Desc : LSP.Messages.ALS_Source_Dir_Description;
+      Source_Dirs : constant GNATCOLL.VFS.File_Array :=
+        Self.Contexts.All_Source_Directories
+          (Include_Externally_Built => True);
+   begin
+      for Dir of Source_Dirs loop
+         Unit_Desc :=
+           (name => VSS.Strings.Conversions.To_Virtual_String
+              (+Dir.Base_Dir_Name),
+            uri  =>
+              File_To_URI (Dir.Display_Full_Name));
+         Response.result.Append (Unit_Desc);
+      end loop;
+
+      Self.Trace.Trace
+        ("Response.result.length: " & Response.result.Length'Img);
+
+      return Response;
+   end On_ALS_Source_Dirs_Request;
+
+   --------------------------------------
    -- On_ALS_Show_Dependencies_Request --
-   ----------------------------------
+   --------------------------------------
 
    overriding function On_ALS_Show_Dependencies_Request
      (Self    : access Message_Handler;

source/ada/lsp-ada_handlers.ads

@@ -526,6 +526,11 @@ private
       Request : LSP.Messages.Server_Requests.ALS_Show_Dependencies_Request)
       return LSP.Messages.Server_Responses.ALS_ShowDependencies_Response;
 
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Message_Handler;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response;
+
    overriding function On_ALS_Debug_Request
      (Self    : access Message_Handler;
       Request : LSP.Messages.Server_Requests.ALS_Debug_Request)

source/ada/lsp-error_decorators.adb

@@ -626,6 +626,26 @@ package body LSP.Error_Decorators is
       return LSP.Messages.Server_Responses.ALS_ShowDependencies_Response
       renames ALS_Show_Dependencies_Request;
 
+   -----------------------------
+   -- ALS_Source_Dirs_Request --
+   -----------------------------
+
+   function ALS_Source_Dirs_Request is new Generic_Request
+     (Request    =>
+         LSP.Messages.Server_Requests.ALS_Source_Dirs_Request,
+      Response   =>
+         LSP.Messages.Server_Responses.ALS_SourceDirs_Response,
+      Handler    =>
+         LSP.Server_Request_Handlers.Server_Request_Handler,
+      On_Request =>
+         LSP.Server_Request_Handlers.On_ALS_Source_Dirs_Request);
+
+   overriding function On_ALS_Source_Dirs_Request
+     (Self    : access Error_Decorator;
+      Request : LSP.Messages.Server_Requests.ALS_Source_Dirs_Request)
+      return LSP.Messages.Server_Responses.ALS_SourceDirs_Response
+      renames ALS_Source_Dirs_Request;
+
    --------------------------
    -- On_ALS_Debug_Request --
    --------------------------