Enable multiple-level fold section of R document like RStudio

DESCRIPTION

@@ -48,5 +48,5 @@ ByteCompile: yes
 Encoding: UTF-8
 NeedsCompilation: yes
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1
 Config/testthat/edition: 3

R/folding.R

@@ -1,37 +1,24 @@
 FoldingRangeKind <- list(
-  Comment = "comment",
-  Imports = "imports",
-  Region = "region"
+    Comment = "comment",
+    Imports = "imports",
+    Region = "region"
 )
 
-get_block_folding_ranges <- function(xdoc) {
-    blocks <- xml_find_all(xdoc, "//expr[@line1 < @line2 and
-        (OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE)/@line1 <
-        (OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE)/@line1]"
-    )
-    if (length(blocks) == 0) {
+get_comment_folding_ranges <- function(xdoc) {
+    comments <- xml_find_all(xdoc, "//COMMENT")
+    if (identical(length(comments), 0L)) {
         return(NULL)
     }
-
-    block_start <- xml_find_first(blocks, "OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE")
-    block_end <- xml_find_first(blocks, "OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE")
-
-    block_start_line <- as.integer(xml_attr(block_start, "line1"))
-    block_end_line <- as.integer(xml_attr(block_end, "line1"))
-
-    block_folding_ranges <- .mapply(function(start_line, end_line) {
-        list(
-            startLine = start_line - 1,
-            endLine = end_line - 2,
-            kind = FoldingRangeKind$Region
+    comments <- comments[
+        !grepl(
+            paste0(
+                "(", section_range_regex, ")\\s*$"
+            ),
+            xml_text(comments, trim = FALSE),
+            perl = TRUE
         )
-    }, list(block_start_line, block_end_line), NULL)
-    block_folding_ranges
-}
-
-get_comment_folding_ranges <- function(xdoc) {
-    comments <- xml_find_all(xdoc, "//COMMENT")
-    if (length(comments) == 0) {
+    ]
+    if (identical(length(comments), 0L)) {
         return(NULL)
     }
     comm_line1 <- as.integer(xml_attr(comments, "line1"))
@@ -64,9 +51,12 @@ get_comment_folding_ranges <- function(xdoc) {
     comm_folding_ranges
 }
 
-get_section_folding_ranges <- function(uri, document) {
-    sections <- get_document_sections(uri, document, type = c("section", "chunk"))
-    if (length(sections) == 0) {
+get_section_and_block_folding_ranges <- function(document, xdoc) {
+
+    sections <- get_document_sections_and_blocks(
+        document = document, xdoc = xdoc
+    )
+    if (!length(sections)) {
         return(NULL)
     }
     section_folding_ranges <- lapply(sections, function(section) {
@@ -79,11 +69,62 @@ get_section_folding_ranges <- function(uri, document) {
     section_folding_ranges
 }
 
+#' Main util function to get folding range (sections and blocks).
+#' sections ranges are indicated by `section_mark_suffix`
+#' blocks ranges are codes between pairs like ("[" and "]"), ("(" and ")"), and ("{" and "}").
+#' @noRd
+get_document_sections_and_blocks <- function(document, xdoc) {
+    if (document$is_rmarkdown) {
+        get_rmd_document_sections_and_blocks(document$content, xdoc = xdoc)
+    } else {
+        get_r_document_sections_and_blocks(
+            content = document$content, xdoc = xdoc, symbol = FALSE
+        )
+    }
+}
+
+#' @noRd
+get_document_blocks <- function(xdoc) {
+    if (is.null(xdoc)) {
+        return(NULL)
+    }
+    blocks <- xml_find_all(xdoc, "//expr[@line1 < @line2 and
+        (OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE)/@line1 <
+        (OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE)/@line1]")
+    if (!length(blocks)) { # prevent floating point comparision
+        return(NULL)
+    }
+
+    block_start <- xml_find_first(blocks, "OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE")
+    block_end <- xml_find_first(blocks, "OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE")
+
+    block_start_line <- as.integer(xml_attr(block_start, "line1"))
+    block_end_line <- as.integer(xml_attr(block_end, "line1"))
+
+    block_folding_ranges <- .mapply(function(start_line, end_line) {
+        list(
+            type = "block",
+            start_line = start_line,
+            end_line = end_line - 1L
+        )
+    }, list(block_start_line, block_end_line), NULL)
+    block_folding_ranges
+}
+
+#---------------------------rmd document utils functions----------------------#
+#' rmd document util function to get folding range - sections and blocks.
+#' @noRd
+get_rmd_document_sections_and_blocks <- function(content, xdoc) {
+    blocks <- get_document_blocks(xdoc)
+    sections <- get_rmd_document_sections(
+        content, c("section", "chunk")
+    )
+    c(blocks, sections)
+}
+
 #' Get all the folding ranges in the document
 #' @noRd
 document_folding_range_reply <- function(id, uri, workspace, document) {
-    result <- NULL
-
     parse_data <- workspace$get_parse_data(uri)
     if (is.null(parse_data) ||
         (!is.null(parse_data$version) && parse_data$version != document$version)) {
@@ -92,16 +133,16 @@ document_folding_range_reply <- function(id, uri, workspace, document) {
 
     xdoc <- parse_data$xml_doc
     if (!is.null(xdoc)) {
-        result <- c(result,
-            get_block_folding_ranges(xdoc),
-            get_comment_folding_ranges(xdoc)
-        )
+        comment_ranges <- get_comment_folding_ranges(xdoc)
     }
+    section_ranges <- get_section_and_block_folding_ranges(
+        document, xdoc
+    )
 
-    result <- c(result, get_section_folding_ranges(uri, document))
+    result <- c(comment_ranges, section_ranges)
 
     result <- unique(result)
-    if (length(result) == 0) {
+    if (!length(result)) { # prevent floating point comparision
         Response$new(id)
     } else {
         Response$new(