From 80412c480a99cc06edecefb8bc59005f9c4e8b92 Mon Sep 17 00:00:00 2001 From: zzxahahah Date: Mon, 16 Sep 2024 16:32:14 +0800 Subject: [PATCH 1/4] Add some feature --- R/session/vsc.R | 72 ++++++++++++++++++++++++++++++++++++- src/session.ts | 94 ++++++++++++++++++++++++++++++++++++++++++++++++- tsconfig.json | 1 + 3 files changed, 165 insertions(+), 2 deletions(-) diff --git a/R/session/vsc.R b/R/session/vsc.R index 5ab461394..533ded731 100644 --- a/R/session/vsc.R +++ b/R/session/vsc.R @@ -522,6 +522,58 @@ if (show_view) { stop("data must be a data.frame or a matrix") } } +##############view S4 object################ +traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold = 20, head_length = 5) { + if (current_depth > max_depth) { + return("Max depth reached") + } + + if (isS4(obj)) { + slots <- slotNames(obj) + result <- list() + for (slot in slots) { + content <- slot(obj, slot) + result[[slot]] <- traverse_S4(content, max_depth, current_depth + 1, length_threshold, head_length) + } + return(result) + } else if (is.list(obj)) { + result <- lapply(obj, function(x) { + traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length) + }) + return(result) + } else if (is.vector(obj) || is.double(obj) || is.character(obj)) { + len <- length(obj) + if (len > length_threshold) { + obj_subset <- obj[1:head_length] + obj_subset <- c(obj_subset, paste("原始长度:", len, "- 显示前", head_length, "个元素")) + return(obj_subset) + } else { + return(obj) + } + } else if (is.factor(obj)) { + levels_len <- length(levels(obj)) + if (levels_len > length_threshold) { + levels_subset <- levels(obj)[1:head_length] + levels_subset <- c(levels_subset, paste("原始levels长度:", levels_len, "- 显示前", head_length, "个levels")) + return(list(levels = levels_subset)) + } else { + return(list(levels = levels(obj))) + } + } else if (is.matrix(obj) || is.data.frame(obj)) { + nrows <- nrow(obj) + if (nrows > length_threshold) { + obj_subset <- head(obj, head_length) + attr(obj_subset, "info") <- paste("原始行数:", nrows, "- 显示前", head_length, "行") + return(obj_subset) + } else { + return(obj) + } + } else { + return("Unknown type") + } +} + + show_dataview <- function(x, title, uuid = NULL, viewer = getOption("vsc.view", "Two"), @@ -607,7 +659,7 @@ if (show_view) { } else if (is.list(x)) { tryCatch({ file <- tempfile(tmpdir = tempdir, fileext = ".json") - jsonlite::write_json(x, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE) + save_structure_to_json(x, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE) request("dataview", source = "list", type = "json", title = title, file = file, viewer = viewer, uuid = uuid ) @@ -619,6 +671,24 @@ if (show_view) { title = title, file = file, viewer = viewer, uuid = uuid ) }) + } else if (isS4(x)) { + tryCatch({ + file <- tempfile(tmpdir = tempdir(), fileext = ".json") + print(file) + structure_overview <- traverse_S4(x) + jsonlite::write_json(structure_overview, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE) + request("dataview", source = "S4", type = "json", + title = title, file = file, viewer = viewer, uuid = uuid + ) + }, error = function(e) { + file <- file.path(tempdir, paste0(make.names(title), ".txt")) + text <- utils::capture.output(print(x)) + writeLines(text, file) + request("dataview", source = "object", type = "txt", + title = title, file = file, viewer = viewer, uuid = uuid + ) + }) + } else { file <- file.path(tempdir, paste0(make.names(title), ".R")) if (is.primitive(x)) { diff --git a/src/session.ts b/src/session.ts index b5959019a..165d11159 100644 --- a/src/session.ts +++ b/src/session.ts @@ -16,6 +16,7 @@ import { IRequest } from './liveShare/shareSession'; import { homeExtDir, rWorkspace, globalRHelp, globalHttpgdManager, extensionContext, sessionStatusBarItem } from './extension'; import { UUID, rHostService, rGuestService, isLiveShare, isHost, isGuestSession, closeBrowser, guestResDir, shareBrowser, openVirtualDoc, shareWorkspace } from './liveShare'; + export interface GlobalEnv { [key: string]: { class: string[]; @@ -371,6 +372,21 @@ export async function showDataView(source: string, type: string, title: string, const content = await getListHtml(panel.webview, file); panel.iconPath = new UriIcon('open-preview'); panel.webview.html = content; + } else if (source === 'S4') { + const panel = window.createWebviewPanel('dataview', title, + { + preserveFocus: true, + viewColumn: ViewColumn[viewer as keyof typeof ViewColumn], + }, + { + enableScripts: true, + enableFindWidget: true, + retainContextWhenHidden: true, + localResourceRoots: [Uri.file(resDir)], + }); + const content = await getObjectHtml(panel.webview, file); + panel.iconPath = new UriIcon('open-preview'); + panel.webview.html = content; } else { if (isGuestSession) { const fileContent = await rGuestService?.requestFileContent(file, 'utf8'); @@ -632,7 +648,7 @@ export async function getListHtml(webview: Webview, file: string): Promise { + resDir = isGuestSession ? guestResDir : resDir; + const content = await readContent(file, 'utf8'); + + return ` + + + + + + + + + + + + + 

+
+
+`;
+}
+
+
+
 export async function getWebviewHtml(webview: Webview, file: string, title: string, dir: string, webviewDir: string): Promise {
     const observerPath = Uri.file(path.join(webviewDir, 'observer.js'));
     const body = (await readContent(file, 'utf8') || '').toString()
diff --git a/tsconfig.json b/tsconfig.json
index 2134c6bf3..03d4e5f08 100644
--- a/tsconfig.json
+++ b/tsconfig.json
@@ -21,3 +21,4 @@
         ".github"
     ]
 }
+

From 84154761b84a48b2544edbc3088d7e7e0cfa3136 Mon Sep 17 00:00:00 2001
From: zzxahahah 
Date: Mon, 16 Sep 2024 17:52:02 +0800
Subject: [PATCH 2/4] Add some feature

---
 R/session/vsc.R | 30 ++++++++++++++++++++++++------
 1 file changed, 24 insertions(+), 6 deletions(-)

diff --git a/R/session/vsc.R b/R/session/vsc.R
index 533ded731..6e28b4ffd 100644
--- a/R/session/vsc.R
+++ b/R/session/vsc.R
@@ -537,15 +537,33 @@ traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold
     }
     return(result)
   } else if (is.list(obj)) {
-    result <- lapply(obj, function(x) {
-      traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
-    })
+    len <- length(obj)
+    if (len > length_threshold) {
+      obj_subset <- obj[1:head_length]
+      obj_subset$info <- paste("Length:", len, "- show", head_length, "of them")
+      result <- lapply(obj_subset, function(x) {
+        traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
+      })
+    } else {
+      result <- lapply(obj, function(x) {
+        traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
+      })
+    }
     return(result)
+  } else if (is.vector(obj)) {
+    len <- length(obj)
+    if (len > length_threshold) {
+      obj_subset <- obj[1:head_length]
+      obj_subset <- c(obj_subset, paste("Length:", len, "- show", head_length, "of them"))
+      return(obj_subset)
+    } else {
+      return(obj)
+    }
   } else if (is.vector(obj) || is.double(obj) || is.character(obj)) {
     len <- length(obj)
     if (len > length_threshold) {
       obj_subset <- obj[1:head_length]
-      obj_subset <- c(obj_subset, paste("原始长度:", len, "- 显示前", head_length, "个元素"))
+      obj_subset <- c(obj_subset, paste("Length:", len, "- show", head_length, "of them"))
       return(obj_subset)
     } else {
       return(obj)
@@ -554,7 +572,7 @@ traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold
     levels_len <- length(levels(obj))
     if (levels_len > length_threshold) {
       levels_subset <- levels(obj)[1:head_length]
-      levels_subset <- c(levels_subset, paste("原始levels长度:", levels_len, "- 显示前", head_length, "个levels"))
+      levels_subset <- c(levels_subset, paste("Length of level:", levels_len, "- show", head_length, "of them"))
       return(list(levels = levels_subset))
     } else {
       return(list(levels = levels(obj)))
@@ -563,7 +581,7 @@ traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold
     nrows <- nrow(obj)
     if (nrows > length_threshold) {
       obj_subset <- head(obj, head_length)
-      attr(obj_subset, "info") <- paste("原始行数:", nrows, "- 显示前", head_length, "行")
+      obj_subset$info <- paste("nrows:", nrows, "- show", head_length, "of them")
       return(obj_subset)
     } else {
       return(obj)

From b0d096657808833bf799ebf375cfc550856339db Mon Sep 17 00:00:00 2001
From: zzxahahah 
Date: Mon, 16 Sep 2024 19:05:07 +0800
Subject: [PATCH 3/4] Add some feature

---
 R/session/vsc.R | 15 +++------------
 1 file changed, 3 insertions(+), 12 deletions(-)

diff --git a/R/session/vsc.R b/R/session/vsc.R
index 6e28b4ffd..9be37fa70 100644
--- a/R/session/vsc.R
+++ b/R/session/vsc.R
@@ -537,18 +537,9 @@ traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold
     }
     return(result)
   } else if (is.list(obj)) {
-    len <- length(obj)
-    if (len > length_threshold) {
-      obj_subset <- obj[1:head_length]
-      obj_subset$info <- paste("Length:", len, "- show", head_length, "of them")
-      result <- lapply(obj_subset, function(x) {
-        traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
-      })
-    } else {
-      result <- lapply(obj, function(x) {
-        traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
-      })
-    }
+    result <- lapply(obj, function(x) {
+      traverse_S4(x, max_depth, current_depth + 1, length_threshold, head_length)
+    })
     return(result)
   } else if (is.vector(obj)) {
     len <- length(obj)

From a2b3ff7ce174f1c6f46f1cc66fabf805711e675a Mon Sep 17 00:00:00 2001
From: zzxahahah 
Date: Mon, 16 Sep 2024 20:01:48 +0800
Subject: [PATCH 4/4] fix issue

---
 R/session/vsc.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/session/vsc.R b/R/session/vsc.R
index 9be37fa70..d3f7f8d80 100644
--- a/R/session/vsc.R
+++ b/R/session/vsc.R
@@ -668,7 +668,7 @@ traverse_S4 <- function(obj, max_depth = 5, current_depth = 0, length_threshold
         } else if (is.list(x)) {
             tryCatch({
                 file <- tempfile(tmpdir = tempdir, fileext = ".json")
-                save_structure_to_json(x, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE)
+                jsonlite::write_json(x, file, na = "string", null = "null", auto_unbox = TRUE, force = TRUE)
                 request("dataview", source = "list", type = "json",
                     title = title, file = file, viewer = viewer, uuid = uuid
                 )