@@ -22,16 +22,23 @@ with Ada.Containers.Generic_Anonymous_Array_Sort;
22
22
with GNATCOLL.Traces ;
23
23
with GNATCOLL.VFS ;
24
24
25
+ with LSP.GNATCOLL_Tracers ;
25
26
with LSP.Utils ;
26
27
27
28
with VSS.JSON.Pull_Readers.Simple ;
28
29
with VSS.JSON.Streams ;
29
30
with VSS.Strings.Conversions ;
31
+ with VSS.Strings.Formatters.Booleans ;
32
+ with VSS.Strings.Formatters.Strings ;
33
+ with VSS.Strings.Templates ;
30
34
with VSS.Text_Streams.File_Input ;
31
35
with VSS.Transformers.Casing ;
32
36
33
37
package body LSP.Ada_Configurations is
34
38
39
+ Trace : constant LSP.GNATCOLL_Tracers.Tracer :=
40
+ LSP.GNATCOLL_Tracers.Create (" ALS.CONFIG" , GNATCOLL.Traces.Off);
41
+
35
42
Doc_Style_Values : constant VSS.String_Vectors.Virtual_String_Vector :=
36
43
[for Item in GNATdoc.Comments.Options.Documentation_Style =>
37
44
VSS.Strings.To_Virtual_String (Item'Wide_Wide_Image).Transform
@@ -71,8 +78,7 @@ package body LSP.Ada_Configurations is
71
78
procedure Parse_Ada
72
79
(Self : in out Configuration'Class;
73
80
JSON : LSP.Structures.LSPAny;
74
- From : Positive;
75
- Reload : out Boolean);
81
+ From : Positive);
76
82
77
83
-- --------------
78
84
-- Build_Path --
@@ -136,26 +142,18 @@ package body LSP.Ada_Configurations is
136
142
procedure Parse_Ada
137
143
(Self : in out Configuration'Class;
138
144
JSON : LSP.Structures.LSPAny;
139
- From : Positive;
140
- Reload : out Boolean)
145
+ From : Positive)
141
146
is
142
147
use all type VSS.JSON.JSON_Number_Kind;
143
148
use all type VSS.JSON.Streams.JSON_Stream_Element_Kind;
144
- use type VSS.String_Vectors.Virtual_String_Vector;
145
149
146
150
Index : Positive := From;
147
151
Variables_Names : VSS.String_Vectors.Virtual_String_Vector;
148
152
Variables_Values : VSS.String_Vectors.Virtual_String_Vector;
149
- Follow_Symlinks : constant Boolean := Self.Follow_Symlinks;
150
153
151
154
procedure Parse_Variables (From : Positive);
152
155
procedure Swap_Variables (Left, Right : Positive);
153
156
154
- procedure Set
155
- (Target : in out VSS.Strings.Virtual_String;
156
- Value : VSS.Strings.Virtual_String);
157
- -- If Target /= Value then assign Target and set Reload to Trues
158
-
159
157
-- -------------------
160
158
-- Parse_Variables --
161
159
-- -------------------
@@ -181,20 +179,6 @@ package body LSP.Ada_Configurations is
181
179
end loop ;
182
180
end Parse_Variables ;
183
181
184
- -- -------
185
- -- Set --
186
- -- -------
187
-
188
- procedure Set
189
- (Target : in out VSS.Strings.Virtual_String;
190
- Value : VSS.Strings.Virtual_String) is
191
- begin
192
- if Target /= Value then
193
- Target := Value;
194
- Reload := True;
195
- end if ;
196
- end Set ;
197
-
198
182
-- ------------------
199
183
-- Swap_Variables --
200
184
-- ------------------
@@ -220,7 +204,6 @@ package body LSP.Ada_Configurations is
220
204
221
205
Name : VSS.Strings.Virtual_String;
222
206
begin
223
- Reload := False;
224
207
Index := Index + 1 ; -- skip start object
225
208
226
209
while Index <= JSON.Last_Index
@@ -232,17 +215,17 @@ package body LSP.Ada_Configurations is
232
215
if Name = " relocateBuildTree"
233
216
and then JSON (Index).Kind = String_Value
234
217
then
235
- Set ( Self.Relocate_Build_Tree, JSON (Index).String_Value) ;
218
+ Self.Relocate_Build_Tree := JSON (Index).String_Value;
236
219
237
220
elsif Name = " rootDir"
238
221
and then JSON (Index).Kind = String_Value
239
222
then
240
- Set ( Self.Relocate_Root, JSON (Index).String_Value) ;
223
+ Self.Relocate_Root := JSON (Index).String_Value;
241
224
242
225
elsif Name = " projectFile"
243
226
and then JSON (Index).Kind = String_Value
244
227
then
245
- Set ( Self.Project_File, JSON (Index).String_Value) ;
228
+ Self.Project_File := JSON (Index).String_Value;
246
229
247
230
elsif Name = " projectDiagnostics"
248
231
and then JSON (Index).Kind = Boolean_Value
@@ -255,10 +238,6 @@ package body LSP.Ada_Configurations is
255
238
Parse_Variables (Index);
256
239
Sort_Variables (1 , Variables_Names.Length);
257
240
258
- Reload := Reload or else
259
- Variables_Names /= Self.Variables_Names or else
260
- Variables_Values /= Self.Variables_Values;
261
-
262
241
Self.Variables_Names := Variables_Names;
263
242
Self.Variables_Values := Variables_Values;
264
243
@@ -276,7 +255,7 @@ package body LSP.Ada_Configurations is
276
255
elsif Name = " defaultCharset"
277
256
and then JSON (Index).Kind = String_Value
278
257
then
279
- Set ( Self.Charset, JSON (Index).String_Value) ;
258
+ Self.Charset := JSON (Index).String_Value;
280
259
281
260
elsif Name = " enableDiagnostics"
282
261
and then JSON (Index).Kind = Boolean_Value
@@ -318,7 +297,6 @@ package body LSP.Ada_Configurations is
318
297
and then JSON (Index).Kind = Boolean_Value
319
298
then
320
299
Self.Follow_Symlinks := JSON (Index).Boolean_Value;
321
- Reload := Reload or else Follow_Symlinks /= Self.Follow_Symlinks;
322
300
323
301
elsif Name = " documentationStyle"
324
302
and then JSON (Index).Kind = String_Value
@@ -403,7 +381,6 @@ package body LSP.Ada_Configurations is
403
381
Input : aliased VSS.Text_Streams.File_Input.File_Input_Text_Stream;
404
382
Reader : VSS.JSON.Pull_Readers.Simple.JSON_Simple_Pull_Reader;
405
383
JSON : LSP.Structures.LSPAny;
406
- Ignore : Boolean;
407
384
begin
408
385
Input.Open (File, " utf-8" );
409
386
Reader.Set_Stream (Input'Unchecked_Access);
@@ -416,7 +393,7 @@ package body LSP.Ada_Configurations is
416
393
Reader.Read_Next;
417
394
end loop ;
418
395
419
- Self.Parse_Ada (JSON, JSON.First_Index, Ignore );
396
+ Self.Parse_Ada (JSON, JSON.First_Index);
420
397
end Read_File ;
421
398
422
399
-- -------------
@@ -425,32 +402,27 @@ package body LSP.Ada_Configurations is
425
402
426
403
procedure Read_JSON
427
404
(Self : in out Configuration'Class;
428
- JSON : LSP.Structures.LSPAny;
429
- Reload : out Boolean)
405
+ JSON : LSP.Structures.LSPAny)
430
406
is
431
407
use all type VSS.JSON.Streams.JSON_Stream_Element_Kind;
432
408
Index : Positive := JSON.First_Index + 1 ;
433
409
434
410
begin
435
- Reload := False;
436
-
437
411
if JSON.Is_Empty or else JSON.First_Element.Kind /= Start_Object then
438
412
return ;
439
413
end if ;
440
414
441
- while Index < JSON.Last_Index
442
- and then JSON (Index).Kind = Key_Name
415
+ while Index < JSON.Last_Index and then JSON (Index).Kind = Key_Name
443
416
loop
444
417
declare
445
418
Is_Ada : constant Boolean := JSON (Index).Key_Name = " ada" ;
446
419
begin
447
420
Index := Index + 1 ;
448
421
449
- if Is_Ada and then
450
- Index <= JSON.Last_Index and then
451
- JSON (Index).Kind = Start_Object
422
+ if Is_Ada and then Index <= JSON.Last_Index
423
+ and then JSON (Index).Kind = Start_Object
452
424
then
453
- Self.Parse_Ada (JSON, Index, Reload );
425
+ Self.Parse_Ada (JSON, Index);
454
426
exit ;
455
427
else
456
428
Skip_Value (JSON, Index);
@@ -483,4 +455,122 @@ package body LSP.Ada_Configurations is
483
455
end loop ;
484
456
end Skip_Value ;
485
457
458
+ function Diff
459
+ (Old, Nnew : VSS.Strings.Virtual_String;
460
+ Setting_Name : VSS.Strings.Virtual_String) return Boolean;
461
+ -- A setting comparison helper that logs when a difference is detected.
462
+
463
+ -- --------
464
+ -- Diff --
465
+ -- --------
466
+
467
+ function Diff
468
+ (Old, Nnew : VSS.Strings.Virtual_String;
469
+ Setting_Name : VSS.Strings.Virtual_String) return Boolean
470
+ is
471
+ use VSS.Strings.Formatters.Strings;
472
+ begin
473
+ if Old /= Nnew then
474
+ if Trace.Active then
475
+ Trace.Trace_Text
476
+ (VSS.Strings.Templates.To_Virtual_String_Template
477
+ (" Signaling project reload because the setting '{}' changed from '{}' to '{}'" )
478
+ .Format
479
+ (Image (Setting_Name), Image (Old), Image (Nnew)));
480
+ end if ;
481
+ return True;
482
+ else
483
+ return False;
484
+ end if ;
485
+ end Diff ;
486
+
487
+ function Diff
488
+ (Old, Nnew : Boolean; Setting_Name : VSS.Strings.Virtual_String)
489
+ return Boolean;
490
+ -- A setting comparison helper that logs when a difference is detected.
491
+
492
+ -- --------
493
+ -- Diff --
494
+ -- --------
495
+
496
+ function Diff
497
+ (Old, Nnew : Boolean; Setting_Name : VSS.Strings.Virtual_String)
498
+ return Boolean
499
+ is
500
+ use VSS.Strings.Formatters.Strings;
501
+ use VSS.Strings.Formatters.Booleans;
502
+ begin
503
+ if Old /= Nnew then
504
+ if Trace.Active then
505
+ Trace.Trace_Text
506
+ (VSS.Strings.Templates.To_Virtual_String_Template
507
+ (" Signaling project reload because the setting '{}' changed from '{}' to '{}'" )
508
+ .Format
509
+ (Image (Setting_Name), Image (Old), Image (Nnew)));
510
+ end if ;
511
+ return True;
512
+ else
513
+ return False;
514
+ end if ;
515
+ end Diff ;
516
+
517
+ function Diff
518
+ (Old, Nnew : GPR2.Context.Object;
519
+ Setting_Name : VSS.Strings.Virtual_String) return Boolean;
520
+ -- A setting comparison helper that logs when a difference is detected.
521
+
522
+ -- --------
523
+ -- Diff --
524
+ -- --------
525
+
526
+ function Diff
527
+ (Old, Nnew : GPR2.Context.Object;
528
+ Setting_Name : VSS.Strings.Virtual_String) return Boolean
529
+ is
530
+ use VSS.Strings.Formatters.Strings;
531
+ use type GPR2.Context.Object;
532
+ begin
533
+ if Old /= Nnew then
534
+ if Trace.Active then
535
+ Trace.Trace_Text
536
+ (VSS.Strings.Templates.To_Virtual_String_Template
537
+ (" Signaling project reload because the setting '{}' changed" )
538
+ .Format
539
+ (Image (Setting_Name)));
540
+ end if ;
541
+ return True;
542
+ else
543
+ return False;
544
+ end if ;
545
+ end Diff ;
546
+
547
+ -- ----------------
548
+ -- Needs_Reload --
549
+ -- ----------------
550
+
551
+ function Needs_Reload
552
+ (Self : Configuration; Other : Configuration'Class) return Boolean
553
+ is
554
+ Reload : Boolean := False;
555
+ begin
556
+ Reload :=
557
+ Diff
558
+ (Self.Relocate_Build_Tree, Other.Relocate_Build_Tree,
559
+ " relocateBuildTree" )
560
+ or else Diff
561
+ (Self.Relocate_Root, Other.Relocate_Root, " rootDir" )
562
+ or else Diff (Self.Project_File, Other.Project_File, " projectFile" )
563
+ or else Diff (Self.Context, Other.Context, " scenarioVariables" )
564
+ or else Diff (Self.Charset, Other.Charset, " defaultCharset" )
565
+ or else Diff
566
+ (Self.Follow_Symlinks, Other.Follow_Symlinks, " followSymlinks" );
567
+
568
+ if not Reload and then Trace.Active then
569
+ Trace.Trace
570
+ (" No change in configuration that warrants a project reload." );
571
+ end if ;
572
+
573
+ return Reload;
574
+ end Needs_Reload ;
575
+
486
576
end LSP.Ada_Configurations ;
0 commit comments