Improve shinychat integration in btw_app()

NEWS.md

@@ -2,6 +2,8 @@
 
 ## New features
 
+* `btw_app()` now keeps tool selection synchronized when switching models and prevents model, prompt, chat, or tool changes while a response is streaming. Long-form tool results can be expanded fullscreen, and file actions now appear in tool result footers. Fullscreen R results include keyboard focus trapping and focus restoration (#208).
+
 * Added `btw pkg desc <packages...>` to show useful DESCRIPTION metadata for installed packages. By default, the command includes package identity, authorship, licensing, URLs, dependencies, and system requirements; use `--fields` to select other fields or `--fields=all` for the complete DESCRIPTION. Multiple terminal results are separated by `---`, and `--json` returns an object keyed by package name (#209).
 
 * Added a `btw pkg src` CLI command family for inspecting R namespace implementations in installed packages and the current development package. Use `list` to discover objects, `get` to retrieve exact source when available or deparsed functions otherwise, `methods` to inspect package-owned S3 and S4 implementations, `path` to locate package installations, and `search` to search real or reconstructed R source. All commands support JSON output, and `methods --source` returns method implementations directly (#207).

R/btw_client_app.R

@@ -147,31 +147,36 @@ btw_app_from_client <- function(
         height = "100%",
         style = bslib::css(max_height = "100%"),
         open = "closed",
-        shiny::div(
-          class = "btn-group",
-          shiny::actionButton(
-            "select_all",
-            "Select All",
-            icon = shiny::icon("check-square"),
-            class = "btn-sm"
+        shiny::tags$fieldset(
+          id = "tools_controls",
+          class = "btw-tools-controls",
+          shiny::div(
+            class = "btn-group",
+            shiny::actionButton(
+              "select_all",
+              "Select All",
+              icon = shiny::icon("check-square"),
+              class = "btn-sm"
+            ),
+            shiny::actionButton(
+              "deselect_all",
+              "Select none",
+              icon = shiny::icon("square"),
+              class = "btn-sm"
+            )
           ),
-          shiny::actionButton(
-            "deselect_all",
-            "Select none",
-            icon = shiny::icon("square"),
-            class = "btn-sm"
+          shiny::div(
+            class = "overflow-y-auto overflow-x-visible",
+            app_tool_group_inputs(
+              btw_tools_df(all_available_tools),
+              # names(list()) is NULL, but NULL means "select all" in
+              # app_tool_group_choice_input; use character(0) for "select none".
+              initial_tool_names = names(original_client_tools) %||%
+                character(0)
+            ),
+            shiny::uiOutput("ui_other_tools")
           )
         ),
-        shiny::div(
-          class = "overflow-y-auto overflow-x-visible",
-          app_tool_group_inputs(
-            btw_tools_df(all_available_tools),
-            # names(list()) is NULL, but NULL means "select all" in
-            # app_tool_group_choice_input; use character(0) for "select none".
-            initial_tool_names = names(original_client_tools) %||% character(0)
-          ),
-          shiny::uiOutput("ui_other_tools")
-        ),
         bslib::input_dark_mode(style = "display: none")
       ),
       shiny::actionButton(
@@ -194,14 +199,12 @@ btw_app_from_client <- function(
         messages = messages,
         greeting = btw_app_greeting(path_logo),
         width = "min(750px, 100%)",
-        footer = if (utils::packageVersion("shinychat") >= "0.4.0") {
-          btw_status_bar_ui(
-            "status_bar",
-            client = client,
-            models = app_models,
-            selected = selected_client
-          )
-        }
+        footer = btw_status_bar_ui(
+          "status_bar",
+          client = client,
+          models = app_models,
+          selected = selected_client
+        )
       ),
       btw_app_html_dep(),
     )
@@ -210,13 +213,21 @@ btw_app_from_client <- function(
   server <- function(input, output, session) {
     chat <- shinychat::chat_mod_server("chat", client = client)
 
-    if (utils::packageVersion("shinychat") >= "0.4.0") {
-      res <- btw_status_bar_server("status_bar", chat, app_models)
+    res <- btw_status_bar_server("status_bar", chat, app_models)
 
-      shiny::observeEvent(res$clear_chat(), {
+    shiny::observeEvent(res$clear_chat(), {
+      if (identical(chat$status(), "idle")) {
         chat$clear(client_history = "clear")
-      })
-    }
+      }
+    })
+
+    shiny::observe({
+      app_set_disabled(
+        session,
+        "tools_controls",
+        identical(chat$status(), "streaming")
+      )
+    })
 
     shiny::observeEvent(input$show_sidebar, {
       bslib::toggle_sidebar("tools_sidebar")
@@ -261,6 +272,10 @@ btw_app_from_client <- function(
     })
 
     shiny::observeEvent(input$select_all, {
+      if (identical(chat$status(), "streaming")) {
+        return()
+      }
+
       tools <- btw_tools_df(all_available_tools)
       for (group in tool_groups) {
         shiny::updateCheckboxGroupInput(
@@ -272,6 +287,10 @@ btw_app_from_client <- function(
     })
 
     shiny::observeEvent(input$deselect_all, {
+      if (identical(chat$status(), "streaming")) {
+        return()
+      }
+
       tools <- btw_tools_df(all_available_tools)
       for (group in tool_groups) {
         shiny::updateCheckboxGroupInput(
@@ -287,31 +306,25 @@ btw_app_from_client <- function(
         current <- input[[paste0("tools_", group)]]
         all_tools <- btw_tools_df(all_available_tools)
         group_tools <- all_tools[all_tools$group == group, ][["name"]]
-        if (length(current) == length(group_tools)) {
-          # All selected, so deselect all
-          shiny::updateCheckboxGroupInput(
-            session = session,
-            inputId = paste0("tools_", group),
-            selected = ""
-          )
-        } else {
-          # Not all selected, so select all
-          shiny::updateCheckboxGroupInput(
-            session = session,
-            inputId = paste0("tools_", group),
-            selected = group_tools
-          )
+        selected <- app_toggle_tool_group(current, group_tools, chat$status())
+        if (is.null(selected)) {
+          return()
         }
+
+        shiny::updateCheckboxGroupInput(
+          session = session,
+          inputId = paste0("tools_", group),
+          selected = selected
+        )
       })
     })
 
     shiny::observe({
-      if (!length(selected_tools())) {
-        client$set_tools(list())
-      } else {
-        sel_tools <- all_available_tools[selected_tools()]
-        client$set_tools(sel_tools)
+      if (identical(chat$status(), "streaming")) {
+        return()
       }
+
+      app_set_client_tools(chat, selected_tools(), all_available_tools)
     })
 
     skills_read_file_mismatch <- shiny::reactive({
@@ -520,6 +533,29 @@ btw_app_greeting <- function(path_logo) {
   )
 }
 
+app_set_disabled <- function(session, id, disabled) {
+  session$sendCustomMessage(
+    "btw_set_disabled",
+    list(
+      ids = as.list(unname(vapply(id, session$ns, character(1)))),
+      disabled = isTRUE(disabled)
+    )
+  )
+}
+
+app_set_client_tools <- function(chat, selected, available) {
+  tools <- if (length(selected)) available[selected] else list()
+  chat$client$set_tools(tools)
+}
+
+app_toggle_tool_group <- function(current, group_tools, status) {
+  if (identical(status, "streaming")) {
+    return(NULL)
+  }
+
+  if (length(current) == length(group_tools)) character() else group_tools
+}
+
 # Status Bar ----
 
 notifier <- function(icon, action, error = NULL, ...) {
@@ -692,6 +728,10 @@ btw_status_bar_server <- function(id, chat, models = "provider") {
       })
 
       shiny::observeEvent(input$model, ignoreInit = TRUE, {
+        if (identical(chat$status(), "streaming")) {
+          return()
+        }
+
         tryCatch(
           {
             old_provider <- chat$client$get_provider()@name
@@ -713,9 +753,9 @@ btw_status_bar_server <- function(id, chat, models = "provider") {
             }
 
             chat$set_client(new_client, sync = FALSE)
-            new_provider <- chat$client$get_provider()@name
+            new_provider <- new_client$get_provider()@name
             provider_name(new_provider)
-            model_name(chat$client$get_model())
+            model_name(new_client$get_model())
 
             notifier(
               shiny::icon("check"),
@@ -738,6 +778,14 @@ btw_status_bar_server <- function(id, chat, models = "provider") {
         )
       })
 
+      shiny::observe({
+        app_set_disabled(
+          session,
+          c("model", "show_sys_prompt", "clear_chat"),
+          identical(chat$status(), "streaming")
+        )
+      })
+
       chat_tokens <- shiny::reactiveVal(
         chat_get_tokens(chat$client),
         label = "btw_app_tokens"

R/tool-agent-custom.R

@@ -282,7 +282,11 @@ btw_tool_agent_custom_impl <- function(
       provider = result$provider,
       model = result$model,
       tokens = result$tokens,
-      display = list(markdown = display_md, show_request = FALSE)
+      display = list(
+        markdown = display_md,
+        show_request = FALSE,
+        full_screen = TRUE
+      )
     )
   )
 }

R/tool-agent-subagent.R

@@ -359,7 +359,11 @@ btw_tool_agent_subagent_impl <- function(
       provider = result$provider,
       model = result$model,
       tokens = result$tokens,
-      display = list(markdown = display_md, show_request = FALSE)
+      display = list(
+        markdown = display_md,
+        show_request = FALSE,
+        full_screen = TRUE
+      )
     )
   )
 }

R/tool-docs-news.R

@@ -61,7 +61,7 @@ btw_tool_docs_package_news_impl <- function(package_name, search_term = "") {
 
   BtwPackageNewsToolResult(
     result,
-    extra = list(display = list(markdown = result))
+    extra = list(display = list(markdown = result, full_screen = TRUE))
   )
 }
 

R/tool-docs.R

@@ -196,7 +196,8 @@ btw_tool_docs_help_page_impl <- function(topic, package_name = "") {
       package = resolved$package,
       display = list(
         title = HTML(sprintf('<code>?%s</code>', help_call)),
-        markdown = paste(md, collapse = "\n")
+        markdown = paste(md, collapse = "\n"),
+        full_screen = TRUE
       )
     )
   )
@@ -444,7 +445,8 @@ btw_tool_docs_available_vignettes_impl <- function(package_name) {
     data = df,
     display = list(
       title = sprintf("{%s} Vignettes", package_name),
-      markdown = md_table(df)
+      markdown = md_table(df),
+      full_screen = TRUE
     )
   )
 }
@@ -511,7 +513,8 @@ btw_tool_docs_vignette_impl <- function(
     data = vignette_info,
     display = list(
       title = sprintf("{%s} Vignette: %s", package_name, vignette_info$Title),
-      markdown = paste(md_vignette, collapse = "\n")
+      markdown = paste(md_vignette, collapse = "\n"),
+      full_screen = TRUE
     )
   )
 }

R/tool-env-df.R

@@ -136,7 +136,8 @@ btw_tool_env_describe_data_frame_impl <- function(
         data = data_frame,
         display = list(
           title = "View Data Frame",
-          markdown = data_frame_md
+          markdown = data_frame_md,
+          full_screen = TRUE
         )
       )
     )
@@ -160,7 +161,8 @@ btw_tool_env_describe_data_frame_impl <- function(
     value = res,
     data = data_frame,
     display = list(
-      title = "View Data Frame"
+      title = "View Data Frame",
+      full_screen = TRUE
     )
   )
 }

R/tool-files-edit.R

@@ -182,7 +182,9 @@ btw_tool_files_edit_impl <- function(path, edits) {
       previous_content = previous_content,
       display = list(
         markdown = md_code_block(fs::path_ext(path), new_content),
-        title = HTML(title_with_open_file_button("Edit", path)),
+        title = file_result_title("Edit", path),
+        footer = file_result_footer(path),
+        full_screen = TRUE,
         show_request = FALSE,
         icon = tool_icon("file-save")
       )

R/tool-files-patch.R

@@ -100,7 +100,8 @@ btw_tool_files_patch_impl <- function(patch) {
         extra = list(
           display = list(
             markdown = paste(display_md, collapse = "\n"),
-            show_request = FALSE
+            show_request = FALSE,
+            full_screen = TRUE
           )
         )
       )
@@ -142,6 +143,7 @@ btw_tool_files_patch_impl <- function(patch) {
     display = list(
       markdown = paste(display_md, collapse = "\n"),
       show_request = FALSE,
+      full_screen = TRUE,
       icon = tool_icon("file-save")
     )
   )