@@ -805,254 +805,6 @@ package body LSP.Ada_Documents is
805
805
end if ;
806
806
end Get_Errors ;
807
807
808
- -- ----------------------
809
- -- Get_Folding_Blocks --
810
- -- ----------------------
811
-
812
- procedure Get_Folding_Blocks
813
- (Self : Document;
814
- Context : LSP.Ada_Contexts.Context;
815
- Lines_Only : Boolean;
816
- Comments : Boolean;
817
- Canceled : access function return Boolean;
818
- Result : out LSP.Structures.FoldingRange_Vector)
819
- is
820
- use Libadalang.Common;
821
- use Libadalang.Analysis;
822
-
823
- Location : LSP.Structures.Location;
824
- foldingRange : LSP.Structures.FoldingRange;
825
- Have_With : Boolean := False;
826
-
827
- function Parse (Node : Ada_Node'Class) return Visit_Status;
828
- -- Includes Node location to the result if the node has "proper" kind
829
-
830
- procedure Store_Span (Span : LSP.Structures.A_Range);
831
- -- Include Span to the result .
832
-
833
- -- ---------
834
- -- Parse --
835
- -- ---------
836
-
837
- function Parse (Node : Ada_Node'Class) return Visit_Status
838
- is
839
-
840
- procedure Store_With_Block ;
841
- -- Store folding for with/use clauses as one folding block
842
-
843
- -- --------------------
844
- -- Store_With_Block --
845
- -- --------------------
846
-
847
- procedure Store_With_Block is
848
- begin
849
- if not Have_With then
850
- return ;
851
- end if ;
852
-
853
- if foldingRange.startLine /= foldingRange.endLine then
854
- Result.Append (foldingRange);
855
- end if ;
856
-
857
- Have_With := False;
858
- end Store_With_Block ;
859
-
860
- Result : Visit_Status := Into;
861
- begin
862
- if Canceled.all then
863
- return Stop;
864
- end if ;
865
-
866
- -- Cat_Namespace,
867
- -- Cat_Constructor,
868
- -- Cat_Destructor,
869
- -- Cat_Structure,
870
- -- Cat_Case_Inside_Record,
871
- -- Cat_Union,
872
- -- Cat_Custom
873
-
874
- case Node.Kind is
875
- when Ada_Package_Decl |
876
- Ada_Generic_Formal_Package |
877
- Ada_Package_Body |
878
- -- Cat_Package
879
-
880
- Ada_Type_Decl |
881
-
882
- Ada_Classwide_Type_Decl |
883
- -- Cat_Class
884
-
885
- Ada_Protected_Type_Decl |
886
- -- Cat_Protected
887
-
888
- Ada_Task_Type_Decl |
889
- Ada_Single_Task_Type_Decl |
890
- -- Cat_Task
891
-
892
- Ada_Subp_Decl |
893
- Ada_Subp_Body |
894
- Ada_Generic_Formal_Subp_Decl |
895
- Ada_Abstract_Subp_Decl |
896
- Ada_Abstract_Formal_Subp_Decl |
897
- Ada_Concrete_Formal_Subp_Decl |
898
- Ada_Generic_Subp_Internal |
899
- Ada_Null_Subp_Decl |
900
- Ada_Subp_Renaming_Decl |
901
- Ada_Subp_Body_Stub |
902
- Ada_Generic_Subp_Decl |
903
- Ada_Generic_Subp_Instantiation |
904
- Ada_Generic_Subp_Renaming_Decl |
905
- Ada_Subp_Kind_Function |
906
- Ada_Subp_Kind_Procedure |
907
- Ada_Access_To_Subp_Def |
908
- -- Cat_Procedure
909
- -- Cat_Function
910
- -- Cat_Method
911
-
912
- Ada_Case_Stmt |
913
- -- Cat_Case_Statement
914
-
915
- Ada_If_Stmt |
916
- -- Cat_If_Statement
917
-
918
- Ada_For_Loop_Stmt |
919
- Ada_While_Loop_Stmt |
920
- -- Cat_Loop_Statement
921
-
922
- Ada_Begin_Block |
923
- Ada_Decl_Block |
924
- -- Cat_Declare_Block
925
- -- Cat_Simple_Block
926
-
927
- -- Ada_Return_Stmt |
928
- -- Ada_Extended_Return_Stmt |
929
- Ada_Extended_Return_Stmt_Object_Decl |
930
- -- Cat_Return_Block
931
-
932
- Ada_Select_Stmt |
933
- -- Cat_Select_Statement
934
-
935
- Ada_Entry_Body |
936
- -- Cat_Entry
937
-
938
- Ada_Exception_Handler |
939
- -- Cat_Exception_Handler
940
-
941
- Ada_Pragma_Node_List |
942
- Ada_Pragma_Argument_Assoc |
943
- Ada_Pragma_Node |
944
- -- Cat_Pragma
945
-
946
- Ada_Aspect_Spec =>
947
- -- Cat_Aspect
948
-
949
- Store_With_Block;
950
-
951
- foldingRange.kind :=
952
- (Is_Set => True, Value => LSP.Enumerations.Region);
953
-
954
- Location := Self.To_LSP_Location (Node.Sloc_Range);
955
- Store_Span (Location.a_range);
956
-
957
- when Ada_With_Clause |
958
- Ada_Use_Package_Clause |
959
- Ada_Use_Type_Clause =>
960
-
961
- Location := Self.To_LSP_Location (Node.Sloc_Range);
962
-
963
- if not Have_With then
964
- Have_With := True;
965
-
966
- foldingRange.kind :=
967
- (Is_Set => True, Value => LSP.Enumerations.Imports);
968
-
969
- foldingRange.startLine := Location.a_range.start.line;
970
- end if ;
971
-
972
- foldingRange.endLine := Location.a_range.an_end.line;
973
-
974
- -- Do not step into with/use clause
975
- Result := Over;
976
-
977
- when others =>
978
- Store_With_Block;
979
- end case ;
980
-
981
- return Result;
982
- end Parse ;
983
-
984
- -- --------------
985
- -- Store_Span --
986
- -- --------------
987
-
988
- procedure Store_Span (Span : LSP.Structures.A_Range) is
989
- begin
990
- if not Lines_Only
991
- or else Span.start.line /= Span.an_end.line
992
- then
993
- foldingRange.startLine := Span.start.line;
994
- foldingRange.endLine := Span.an_end.line;
995
-
996
- if not Lines_Only then
997
- foldingRange.startCharacter :=
998
- (Is_Set => True,
999
- Value => Span.start.character);
1000
-
1001
- foldingRange.startCharacter :=
1002
- (Is_Set => True,
1003
- Value => Span.an_end.character);
1004
- end if ;
1005
-
1006
- Result.Append (foldingRange);
1007
- end if ;
1008
- end Store_Span ;
1009
-
1010
- Token : Token_Reference;
1011
- Span : LSP.Structures.A_Range;
1012
- Root : constant Ada_Node'Class := Self.Unit (Context).Root;
1013
-
1014
- begin
1015
- if not Root.Is_Null then
1016
- Traverse (Root, Parse'Access );
1017
- end if ;
1018
-
1019
- if not Comments then
1020
- -- do not process comments
1021
- return ;
1022
- end if ;
1023
-
1024
- -- Looking for comments
1025
- foldingRange.kind := (Is_Set => False);
1026
- Token := First_Token (Self.Unit (Context));
1027
-
1028
- while Token /= No_Token
1029
- and then not Canceled.all
1030
- loop
1031
- case Kind (Data (Token)) is
1032
- when Ada_Comment =>
1033
- if not foldingRange.kind.Is_Set then
1034
- foldingRange.kind :=
1035
- (Is_Set => True, Value => LSP.Enumerations.Comment);
1036
- Span := Self.To_A_Range (Sloc_Range (Data (Token)));
1037
- else
1038
- Span.an_end :=
1039
- Self.To_A_Range (Sloc_Range (Data (Token))).an_end;
1040
- end if ;
1041
-
1042
- when Ada_Whitespace =>
1043
- null ;
1044
-
1045
- when others =>
1046
- if foldingRange.kind.Is_Set then
1047
- Store_Span (Span);
1048
- foldingRange.kind := (Is_Set => False);
1049
- end if ;
1050
- end case ;
1051
-
1052
- Token := Next (Token);
1053
- end loop ;
1054
- end Get_Folding_Blocks ;
1055
-
1056
808
-- -------------------------
1057
809
-- Get_Formatting_Region --
1058
810
-- -------------------------
0 commit comments