@@ -805,254 +805,6 @@ package body LSP.Ada_Documents is
805805 end if ;
806806 end Get_Errors ;
807807
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-
1056808 -- -------------------------
1057809 -- Get_Formatting_Region --
1058810 -- -------------------------
0 commit comments