@@ -104,6 +104,15 @@ package body LSP.Ada_Handlers.Project_Loading is
104
104
-- Reload as project source dirs the directories in
105
105
-- Self.Project_Dirs_Loaded.
106
106
107
+ procedure Create_In_Memory_Project
108
+ (Name : GPR2.Name_Type;
109
+ Dirs : File_Sets.Set;
110
+ Project_Tree : in out GPR2.Project.Tree.Object;
111
+ Success : out Boolean);
112
+ -- Unload Project_Tree then construct a new project in memory with given
113
+ -- Name and source Dirs. Return Success=True and resulting Project_Tree
114
+ -- if everything is fine. Return Success=False otherwise.
115
+
107
116
procedure Update_Project_Predefined_Sources
108
117
(Self : in out Message_Handler'Class);
109
118
-- Fill Self.Project_Predefined_Sources with loaded project tree runtime
@@ -113,6 +122,68 @@ package body LSP.Ada_Handlers.Project_Loading is
113
122
-- This also indexes immediately any already opened document, creating
114
123
-- the handler's fallback context before for that purpose.
115
124
125
+ procedure Create_Fallback_Context (Self : in out Message_Handler'Class);
126
+ -- Create a fallback context for the given handler's contexts' set.
127
+
128
+ -- ---------------------------
129
+ -- Create_Fallback_Context --
130
+ -- ---------------------------
131
+
132
+ procedure Create_Fallback_Context (Self : in out Message_Handler'Class) is
133
+ use LSP.Ada_Context_Sets;
134
+ use LSP.Ada_Contexts;
135
+ use type GNATCOLL.VFS.Virtual_File;
136
+
137
+ C : constant Context_Access := new Context (Self.Tracer);
138
+
139
+ Reader : LSP.Ada_Handlers.File_Readers.LSP_File_Reader
140
+ (Self'Unchecked_Access);
141
+
142
+ Dirs : File_Sets.Set;
143
+
144
+ Project_Tree : GPR2.Project.Tree.Object;
145
+
146
+ Success : Boolean;
147
+ begin
148
+ Self.Tracer.Trace_Text (" Creating fallback context" );
149
+
150
+ C.Initialize
151
+ (File_Reader => Reader,
152
+ Follow_Symlinks => Self.Configuration.Follow_Symlinks,
153
+ Style => Self.Configuration.Documentation_Style,
154
+ As_Fallback_Context => True);
155
+
156
+ if Self.Client.Root_Directory /= GNATCOLL.VFS.No_File then
157
+ Dirs.Insert (Self.Client.Root_Directory);
158
+ end if ;
159
+
160
+ Create_In_Memory_Project
161
+ (" fallback_context" , Dirs, Project_Tree, Success);
162
+
163
+ pragma Assert
164
+ (Success, " Can't create an empty project for the fallback context" );
165
+
166
+ -- Create a basic GPR2_Provider_And_Projects containing only the
167
+ -- implicit project and load it.
168
+ declare
169
+ Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects :=
170
+ (Provider =>
171
+ Libadalang.Project_Provider.Create_Project_Unit_Provider
172
+ (Tree => Project_Tree,
173
+ Project => Project_Tree.Root_Project),
174
+ Projects => <>);
175
+ begin
176
+ Provider.Projects.Append (Project_Tree.Root_Project);
177
+
178
+ C.Load_Project
179
+ (Provider => Provider,
180
+ Tree => Project_Tree,
181
+ Charset => " iso-8859-1" );
182
+ end ;
183
+
184
+ Self.Contexts.Prepend (C);
185
+ end Create_Fallback_Context ;
186
+
116
187
-- -------------------------
117
188
-- Ensure_Project_Loaded --
118
189
-- -------------------------
@@ -684,35 +755,6 @@ package body LSP.Ada_Handlers.Project_Loading is
684
755
-- ------------------------
685
756
686
757
procedure Enqueue_Indexing_Job (Self : in out Message_Handler'Class) is
687
- procedure Create_Fallback_Context (Self : in out Message_Handler'Class);
688
- -- Create a fallback context for the given handler's contexts' set.
689
-
690
- -- ---------------------------
691
- -- Create_Fallback_Context --
692
- -- ---------------------------
693
-
694
- procedure Create_Fallback_Context (Self : in out Message_Handler'Class)
695
- is
696
- use LSP.Ada_Context_Sets;
697
- use LSP.Ada_Contexts;
698
- begin
699
- declare
700
- C : constant Context_Access := new Context (Self.Tracer);
701
- Reader :
702
- LSP.Ada_Handlers.File_Readers.LSP_File_Reader
703
- (Self'Unchecked_Access);
704
- begin
705
- Self.Tracer.Trace_Text (" Creating fallback context" );
706
-
707
- C.Initialize
708
- (File_Reader => Reader,
709
- Follow_Symlinks => Self.Configuration.Follow_Symlinks,
710
- Style => Self.Configuration.Documentation_Style,
711
- As_Fallback_Context => True);
712
- Self.Contexts.Prepend (C);
713
- end ;
714
- end Create_Fallback_Context ;
715
-
716
758
Files : LSP.Ada_Indexing.File_Sets.Set;
717
759
begin
718
760
-- Create a fallback context before indexing. This allows to
@@ -786,21 +828,44 @@ package body LSP.Ada_Handlers.Project_Loading is
786
828
-- --------------------------------
787
829
788
830
procedure Reload_Implicit_Project_Dirs (Self : in out Message_Handler'Class)
831
+ is
832
+ Success : Boolean;
833
+ begin
834
+ Release_Contexts_And_Project_Info (Self);
835
+
836
+ Create_In_Memory_Project
837
+ (Name => " default" ,
838
+ Dirs => Self.Project_Dirs_Loaded,
839
+ Project_Tree => Self.Project_Tree,
840
+ Success => Success);
841
+
842
+ if not Success then
843
+ LSP.Ada_Project_Loading.Set_Load_Status
844
+ (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
845
+ end if ;
846
+ end Reload_Implicit_Project_Dirs ;
847
+
848
+ -- ----------------------------
849
+ -- Create_In_Memory_Project --
850
+ -- ----------------------------
851
+
852
+ procedure Create_In_Memory_Project
853
+ (Name : GPR2.Name_Type;
854
+ Dirs : File_Sets.Set;
855
+ Project_Tree : in out GPR2.Project.Tree.Object;
856
+ Success : out Boolean)
789
857
is
790
858
Project : GPR2.Project.Tree.View_Builder.Object :=
791
859
GPR2.Project.Tree.View_Builder.Create
792
860
(Project_Dir => GPR2.Path_Name.Create_Directory (" ." ),
793
- Name => " default " );
861
+ Name => Name );
794
862
Values : GPR2.Containers.Value_List;
795
863
Opts : GPR2.Options.Object;
796
- Success : Boolean;
797
864
begin
798
- Release_Contexts_And_Project_Info (Self);
799
- Self.Project_Tree.Unload;
800
-
865
+ Project_Tree.Unload;
801
866
-- Load all the dirs
802
867
803
- for Dir of Self.Project_Dirs_Loaded loop
868
+ for Dir of Dirs loop
804
869
Values.Append (Dir.Display_Full_Name);
805
870
end loop ;
806
871
@@ -809,28 +874,25 @@ package body LSP.Ada_Handlers.Project_Loading is
809
874
810
875
-- First we load the fallback project
811
876
Success :=
812
- Self. Project_Tree.Load_Virtual_View
877
+ Project_Tree.Load_Virtual_View
813
878
(Project,
814
879
Opts,
815
880
With_Runtime => True,
816
881
Absent_Dir_Error => GPR2.No_Error);
817
882
818
- if not Success then
819
- for C in Self.Project_Tree.Log_Messages.Iterate loop
883
+ if Success then
884
+ Project_Tree.Update_Sources;
885
+ else
886
+ for C in Project_Tree.Log_Messages.Iterate loop
820
887
Tracer.Trace (C.Element.Format);
821
888
end loop ;
822
- LSP.Ada_Project_Loading.Set_Load_Status
823
- (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
824
889
end if ;
825
890
826
- Self.Project_Tree.Update_Sources;
827
-
828
891
exception
829
892
when E : others =>
830
- Tracer.Trace_Exception (E, " Reload_Implicit_Project_Dirs" );
831
- LSP.Ada_Project_Loading.Set_Load_Status
832
- (Self.Project_Status, LSP.Ada_Project_Loading.Invalid_Project);
833
- end Reload_Implicit_Project_Dirs ;
893
+ Tracer.Trace_Exception (E, " Create_In_Memory_Project" );
894
+ Success := False;
895
+ end Create_In_Memory_Project ;
834
896
835
897
-- ------------------
836
898
-- Reload_Project --
0 commit comments