diff --git a/Developer/Resources/Styles.wl b/Developer/Resources/Styles.wl index e609bdae..ff7df5c3 100644 --- a/Developer/Resources/Styles.wl +++ b/Developer/Resources/Styles.wl @@ -14,8 +14,9 @@ Cell[ CellInsertionPointCell -> $cellInsertionPointCell, CellTrayWidgets -> <| - "GearMenu" -> <| "Condition" -> False |>, - "ChatWidget" -> <| + "GearMenu" -> <| "Condition" -> False |>, + "ChatIncluded" -> <| "Condition" -> False, "Content" -> $includedCellWidget |>, + "ChatWidget" -> <| "Type" -> "Focus", "Content" -> Cell[ BoxData @ TemplateBox[ { }, "ChatWidgetButton" ], "ChatWidget" ] |> @@ -25,7 +26,13 @@ Cell[ "CellBracket" -> contextMenu[ $askMenuItem, $excludeMenuItem, Delimiter, "CellBracket" ], "CellGroup" -> contextMenu[ $excludeMenuItem, Delimiter, "CellGroup" ], "CellRange" -> contextMenu[ $excludeMenuItem, Delimiter, "CellRange" ] - |> + |>, + + PrivateCellOptions -> { + "AccentStyle" -> { + CellTrayWidgets -> <| "ChatIncluded" -> <| "Condition" -> True |> |> + } + } ] @@ -145,20 +152,35 @@ Cell[ Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "EvaluateChatInput", $CellContext`cell ] ], CellEventActions -> { + (* Insert persona prompt input template: *) { "KeyDown", "@" } :> With[ { $CellContext`cell = EvaluationCell[ ] }, Quiet @ Needs[ "Wolfram`Chatbook`" -> None ]; Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "InsertInlineReference", "PersonaTemplate", $CellContext`cell ] ] , + (* Insert function prompt input template: *) { "KeyDown", "!" } :> With[ { $CellContext`cell = EvaluationCell[ ] }, Quiet @ Needs[ "Wolfram`Chatbook`" -> None ]; Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "InsertInlineReference", "FunctionTemplate", $CellContext`cell ] ] , + (* Insert modifier prompt input template: *) { "KeyDown", "#" } :> With[ { $CellContext`cell = EvaluationCell[ ] }, Quiet @ Needs[ "Wolfram`Chatbook`" -> None ]; Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "InsertInlineReference", "ModifierTemplate", $CellContext`cell ] ] + , + (* Highlight cells that will be included in chat context: *) + "MouseEntered" :> With[ { $CellContext`cell = EvaluationCell[ ] }, + Quiet @ Needs[ "Wolfram`Chatbook`" -> None ]; + Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "AccentIncludedCells", $CellContext`cell ] + ] + , + (* Remove cell highlights: *) + "MouseExited" :> With[ { $CellContext`cell = EvaluationCell[ ] }, + Quiet @ Needs[ "Wolfram`Chatbook`" -> None ]; + Symbol[ "Wolfram`Chatbook`ChatbookAction" ][ "RemoveCellAccents", $CellContext`cell ] + ] } ] diff --git a/Developer/StylesheetBuilder.wl b/Developer/StylesheetBuilder.wl index d3e27d5e..bda263a0 100644 --- a/Developer/StylesheetBuilder.wl +++ b/Developer/StylesheetBuilder.wl @@ -84,6 +84,17 @@ Developer`WriteWXFFile[ $iconManifestFile, AssociationMap[ RawBoxes @ TemplateBo +(* ::Subsection::Closed:: *) +(*$includedCellWidget*) + + +$includedCellWidget = Cell[ + BoxData @ ToBoxes @ Dynamic[ $IncludedCellWidget, SingleEvaluation -> True ], + "ChatIncluded" +]; + + + (* ::Subsection::Closed:: *) (*makeIconTemplateBoxStyle*) diff --git a/FrontEnd/StyleSheets/Chatbook.nb b/FrontEnd/StyleSheets/Chatbook.nb index 2997b773..81c9dd36 100644 --- a/FrontEnd/StyleSheets/Chatbook.nb +++ b/FrontEnd/StyleSheets/Chatbook.nb @@ -749,6 +749,19 @@ Notebook[ TaggingRules -> <|"ChatNotebookSettings" -> <||>|>, CellTrayWidgets -> <| "GearMenu" -> <|"Condition" -> False|>, + "ChatIncluded" -> <| + "Condition" -> False, + "Content" -> + Cell[ + BoxData[ + DynamicBox[ + ToBoxes[Wolfram`Chatbook`$IncludedCellWidget, StandardForm], + SingleEvaluation -> True + ] + ], + "ChatIncluded" + ] + |>, "ChatWidget" -> <| "Type" -> "Focus", "Content" -> @@ -1139,11 +1152,16 @@ Notebook[ } ] } - |> + |>, + PrivateCellOptions -> { + "AccentStyle" -> { + CellTrayWidgets -> <|"ChatIncluded" -> <|"Condition" -> True|>|> + } + } ], Cell[ StyleData["ChatStyleSheetInformation"], - TaggingRules -> <|"StyleSheetVersion" -> "1.2.4.3907141550"|> + TaggingRules -> <|"StyleSheetVersion" -> "1.3.1.3908279596"|> ], Cell[ StyleData["Text"], @@ -1602,6 +1620,22 @@ Notebook[ "ModifierTemplate", cell ] + ], + "MouseEntered" :> + With[ { cell = EvaluationCell[] }, + Quiet[Needs["Wolfram`Chatbook`" -> None]]; + Symbol["Wolfram`Chatbook`ChatbookAction"][ + "AccentIncludedCells", + cell + ] + ], + "MouseExited" :> + With[ { cell = EvaluationCell[] }, + Quiet[Needs["Wolfram`Chatbook`" -> None]]; + Symbol["Wolfram`Chatbook`ChatbookAction"][ + "RemoveCellAccents", + cell + ] ] }, CellFrameColor -> RGBColor[0.639216, 0.788235, 0.94902], diff --git a/Source/Chatbook/Actions.wl b/Source/Chatbook/Actions.wl index 061cc34d..35cbaa08 100644 --- a/Source/Chatbook/Actions.wl +++ b/Source/Chatbook/Actions.wl @@ -36,6 +36,7 @@ BeginPackage[ "Wolfram`Chatbook`Actions`" ]; Begin[ "`Private`" ]; Needs[ "Wolfram`Chatbook`" ]; +Needs[ "Wolfram`Chatbook`ChatHistory`" ]; Needs[ "Wolfram`Chatbook`Common`" ]; Needs[ "Wolfram`Chatbook`Dynamics`" ]; Needs[ "Wolfram`Chatbook`Explode`" ]; @@ -88,6 +89,7 @@ ChatCellEvaluate[ args___ ] := (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*ChatbookAction*) +ChatbookAction[ "AccentIncludedCells" , args___ ] := catchMine @ accentIncludedCells @ args; ChatbookAction[ "AIAutoAssist" , args___ ] := catchMine @ AIAutoAssist @ args; ChatbookAction[ "Ask" , args___ ] := catchMine @ AskChat @ args; ChatbookAction[ "AttachCodeButtons" , args___ ] := catchMine @ AttachCodeButtons @ args; @@ -102,13 +104,14 @@ ChatbookAction[ "InsertInlineReference", args___ ] := catchMine @ InsertInlineRe ChatbookAction[ "OpenChatBlockSettings", args___ ] := catchMine @ OpenChatBlockSettings @ args; ChatbookAction[ "OpenChatMenu" , args___ ] := catchMine @ OpenChatMenu @ args; ChatbookAction[ "PersonaManage" , args___ ] := catchMine @ PersonaManage @ args; -ChatbookAction[ "ToolManage" , args___ ] := catchMine @ ToolManage @ args; +ChatbookAction[ "RemoveCellAccents" , args___ ] := catchMine @ removeCellAccents @ args; ChatbookAction[ "Send" , args___ ] := catchMine @ SendChat @ args; ChatbookAction[ "SendFeedback" , args___ ] := catchMine @ SendFeedback @ args; ChatbookAction[ "StopChat" , args___ ] := catchMine @ StopChat @ args; ChatbookAction[ "TabLeft" , args___ ] := catchMine @ TabLeft @ args; ChatbookAction[ "TabRight" , args___ ] := catchMine @ TabRight @ args; ChatbookAction[ "ToggleFormatting" , args___ ] := catchMine @ ToggleFormatting @ args; +ChatbookAction[ "ToolManage" , args___ ] := catchMine @ ToolManage @ args; ChatbookAction[ "WidgetSend" , args___ ] := catchMine @ WidgetSend @ args; ChatbookAction[ name_String , args___ ] := catchMine @ throwFailure[ "NotImplemented", name, args ]; ChatbookAction[ args___ ] := catchMine @ throwInternalFailure @ ChatbookAction @ args; diff --git a/Source/Chatbook/ChatHistory.wl b/Source/Chatbook/ChatHistory.wl new file mode 100644 index 00000000..56225c0f --- /dev/null +++ b/Source/Chatbook/ChatHistory.wl @@ -0,0 +1,284 @@ +(* ::Section::Closed:: *) +(*Package Header*) +BeginPackage[ "Wolfram`Chatbook`ChatHistory`" ]; + +(* :!CodeAnalysis::BeginBlock:: *) + +HoldComplete[ + `accentIncludedCells; + `extraCellHeight; + `filterChatCells; + `getCellsInChatHistory; + `removeCellAccents; +]; + +Begin[ "`Private`" ]; + +Needs[ "Wolfram`Chatbook`" ]; +Needs[ "Wolfram`Chatbook`ChatMessages`" ]; +Needs[ "Wolfram`Chatbook`Common`" ]; +Needs[ "Wolfram`Chatbook`FrontEnd`" ]; +Needs[ "Wolfram`Chatbook`Settings`" ]; + +(* ::**************************************************************************************************************:: *) +(* ::Section::Closed:: *) +(*Configuration*) +$cellFrameColor = RGBColor[ "#a3c9f2" ]; + +$validChatHistoryProperties = { + "CellObjects", + "Cells", + "ChatDelimiter", + "ChatHistoryLength", + "IncludeHistory", + "Messages", + "Settings" +}; + +$$validChatHistoryProperty = Alternatives @@ $validChatHistoryProperties; +$$historyProperty = All | $$validChatHistoryProperty | { $$validChatHistoryProperty... }; + +(* ::**************************************************************************************************************:: *) +(* ::Section::Closed:: *) +(*GetChatHistory*) +GeneralUtilities`SetUsage[ GetChatHistory, "\ +GetChatHistory[cell$] gives the list of cells that would be included in the chat history for the \ +CellObject specified by cell$. +GetChatHistory[cell$,prop$] gives the specified property. + +* The value for prop$ can be any of the following: +| All | all properties returned as an Association | +| \"CellObjects\" | the list of CellObjects that would be included in the chat history | +| \"Cells\" | the list of Cell[$$] expressions that would be included in the chat history | +| \"Messages\" | the chat history as a list of messages | +| \"ChatHistoryLength\" | the max number of cells that would be included in the chat history | +| \"IncludeHistory\" | whether or not chat history apart from the given cell would be included in the chat | +* The default value for prop$ is \"CellObjects\". +* \"IncludeHistory\" and \"ChatHistoryLength\" can be used to determine why the returned list of cells might be limited.\ +" ]; + +GetChatHistory[ cell_CellObject ] := + catchMine @ GetChatHistory[ cell, "CellObjects" ]; + +GetChatHistory[ cell_CellObject, "CellObjects" ] := + catchMine @ getCellsInChatHistory @ cell; + +GetChatHistory[ cell_CellObject, property: $$historyProperty ] := catchMine @ Enclose[ + Module[ { cells, data, as }, + { cells, data } = Reap[ getCellsInChatHistory @ cell, $chatHistoryTag ]; + ConfirmMatch[ cells, { ___CellObject }, "CellObjects" ]; + as = ConfirmBy[ <| data, "CellObjects" -> cells |>, AssociationQ, "Data" ]; + ConfirmMatch[ selectProperties[ as, property ], Except[ _selectProperties ], "SelectedProperties" ] + ], + throwInternalFailure[ GetChatHistory[ cell, property ], ## ] & +]; + +GetChatHistory[ args___ ] := + catchMine @ throwFailure[ "InvalidArguments", GetChatHistory, HoldForm @ GetChatHistory @ args ]; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*selectProperties*) +selectProperties // beginDefinition; +selectProperties[ as_Association, All ] := selectProperties[ as, $validChatHistoryProperties ]; +selectProperties[ as_Association, props: { ___String } ] := AssociationMap[ selectProperties[ as, # ] &, props ]; +selectProperties[ as_Association, prop_String ] /; KeyExistsQ[ as, prop ] := as[ prop ]; +selectProperties[ as_Association, "ChatHistoryLength" ] := as[ "Settings", "ChatHistoryLength" ]; +selectProperties[ as_Association, "IncludeHistory" ] := as[ "Settings", "IncludeHistory" ]; +selectProperties[ as_Association, "Cells" ] := getCellExpressions @ as; +selectProperties[ as_Association, "Messages" ] := constructMessages[ as, as[ "CellObjects" ] ]; +selectProperties // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*getCellExpressions*) +getCellExpressions // beginDefinition; +getCellExpressions[ KeyValuePattern[ "CellObjects" -> cells_ ] ] := getCellExpressions @ cells; +getCellExpressions[ cells: { ___CellObject } ] := NotebookRead @ cells; +getCellExpressions // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*getCellsInChatHistory*) +getCellsInChatHistory // beginDefinition; + +getCellsInChatHistory[ cell_CellObject ] := + getCellsInChatHistory[ topParentCell @ cell, parentNotebook @ cell ]; + +getCellsInChatHistory[ cell_CellObject, nbo_NotebookObject ] := + getCellsInChatHistory[ + cell, + sowHistoryData[ "ChatDelimiter", getPrecedingDelimiter[ cell, nbo ] ], + nbo, + Cells @ nbo + ]; + +getCellsInChatHistory[ + cell_CellObject, + delimiter_CellObject, + nbo_NotebookObject, + { ___, delimiter_, history___, cell_, ___ } +] := selectChatHistoryCells[ sowHistoryData[ "Settings", currentChatSettings @ cell ], { history, cell }, cell ]; + +getCellsInChatHistory[ + cell_CellObject, + _Missing, + nbo_NotebookObject, + { history___, cell_, ___ } +] := selectChatHistoryCells[ sowHistoryData[ "Settings", currentChatSettings @ cell ], { history, cell }, cell ]; + +getCellsInChatHistory // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*sowHistoryData*) +sowHistoryData // beginDefinition; +sowHistoryData[ key_String, value_ ] := (Sow[ key -> value, $chatHistoryTag ]; value); +sowHistoryData[ value_Association ] := Sow[ value, $chatHistoryTag ]; +sowHistoryData // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*selectChatHistoryCells*) +selectChatHistoryCells // beginDefinition; + +selectChatHistoryCells[ settings_Association, cells: { ___CellObject }, cell_CellObject ] := + selectChatHistoryCells[ + settings[ "IncludeHistory" ], + settings[ "ChatHistoryLength" ], + filterChatCells @ sowHistoryData[ "CellInformation", cellInformation @ cells ], + cell + ]; + +selectChatHistoryCells[ False, max_, info: { ___Association }, cell_CellObject ] := + If[ MemberQ[ info, KeyValuePattern[ "CellObject" -> cell ] ], + { cell }, + { } + ]; + +selectChatHistoryCells[ include_, max_? Positive, info: { ___Association }, cell_CellObject ] := + Module[ { take }, + take = Take[ Reverse @ info, UpTo @ max ]; + If[ MemberQ[ take, KeyValuePattern[ "CellObject" -> cell ] ], + Cases[ Reverse @ take, KeyValuePattern[ "CellObject" -> c_ ] :> c ], + { } + ] + ]; + +selectChatHistoryCells[ include_, $$unspecified, info_, cell_ ] := + selectChatHistoryCells[ include, Infinity, info, cell ]; + +selectChatHistoryCells // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*filterChatCells*) +filterChatCells // beginDefinition; + +filterChatCells[ cellInfo: { ___Association } ] := Enclose[ + Module[ { styleExcluded, tagExcluded, cells }, + + styleExcluded = DeleteCases[ cellInfo, KeyValuePattern[ "Style" -> $$chatIgnoredStyle ] ]; + + tagExcluded = DeleteCases[ + styleExcluded, + KeyValuePattern[ "ChatNotebookSettings" -> KeyValuePattern[ "ExcludeFromChat" -> True ] ] + ]; + + tagExcluded + ], + throwInternalFailure[ filterChatCells @ cellInfo, ## ] & +]; + +filterChatCells // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Section::Closed:: *) +(*Included Cell Highlighting*) + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*accentIncludedCells*) +accentIncludedCells // beginDefinition; + +accentIncludedCells[ ___ ] /; insufficientVersionQ[ "AccentedCells" ] := Null; + +accentIncludedCells[ cell_CellObject ] := + accentIncludedCells[ topParentCell @ cell, parentNotebook @ cell ]; + +accentIncludedCells[ cell_CellObject, nbo_NotebookObject ] := + accentIncludedCells0[ nbo, getCellsInChatHistory[ cell, nbo ] ]; + +accentIncludedCells // endDefinition; + + + +accentIncludedCells0 // beginDefinition; + +accentIncludedCells0[ nbo_NotebookObject, cells: { ___CellObject } ] := + FE`Evaluate @ FEPrivate`AccentedCellsSet[ nbo, cells ]; + +accentIncludedCells0 // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*removeCellAccents*) +removeCellAccents // beginDefinition; +removeCellAccents[ ___ ] /; insufficientVersionQ[ "AccentedCells" ] := Null; +removeCellAccents[ nbo_NotebookObject ] := FE`Evaluate @ FEPrivate`AccentedCellsSet[ nbo, { } ]; +removeCellAccents[ cell_CellObject ] := removeCellAccents @ parentNotebook @ cell; +removeCellAccents // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*$includedCellWidget*) +$IncludedCellWidget = With[ { color = $cellFrameColor }, + DynamicModule[ { cell, extra }, + Dynamic @ Framed[ + "", + Background -> color, + ImageSize -> { 2, AbsoluteCurrentValue[ cell, { "CellSize", 2 } ] + extra }, + FrameStyle -> None, + FrameMargins -> -1, + ImageMargins -> 0 + ], + Initialization :> (cell = topParentCell @ EvaluationCell[ ]; extra = extraCellHeight @ cell), + UnsavedVariables :> { cell, extra } + ] +]; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*extraCellHeight*) +extraCellHeight // beginDefinition; + +extraCellHeight[ cell_CellObject ] := extraCellHeight[ cell ] = Max[ + 0, + extraCellHeight[ + AbsoluteCurrentValue[ cell, { CellFrame , 2 } ], + AbsoluteCurrentValue[ cell, { CellFrameMargins, 2 } ] + ] +]; + +extraCellHeight[ f_Integer, margins_ ] := extraCellHeight[ { f, f }, margins ]; +extraCellHeight[ frame_, m_Integer ] := extraCellHeight[ frame, { m, m } ]; +extraCellHeight[ { 0, fT_Integer }, { mB_Integer, mT_Integer } ] := fT + mT; +extraCellHeight[ { fB_Integer, 0 }, { mB_Integer, mT_Integer } ] := fB + mB; +extraCellHeight[ { 0, 0 }, { mB_Integer, mT_Integer } ] := 0; +extraCellHeight[ { fB_Integer, fT_Integer }, { mB_Integer, mT_Integer } ] := fB + fT + mB + mT; +extraCellHeight[ { Except[ _Integer ], ft_Integer }, margins_ ] := extraCellHeight[ { 0, ft }, margins ]; +extraCellHeight[ ___ ] := 0; + +extraCellHeight // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Section::Closed:: *) +(*Package Footer*) +If[ Wolfram`ChatbookInternal`$BuildingMX, + Null; +]; + +(* :!CodeAnalysis::EndBlock:: *) + +End[ ]; +EndPackage[ ]; diff --git a/Source/Chatbook/Common.wl b/Source/Chatbook/Common.wl index f72fbe2b..071afce8 100644 --- a/Source/Chatbook/Common.wl +++ b/Source/Chatbook/Common.wl @@ -79,6 +79,7 @@ $closedChatCellOptions := ]; $versionRequirements = <| + "AccentedCells" -> 14.0, "DynamicSplit" -> 13.3, "TaskWriteOutput" -> 14.0, "TrackScrollingWhenPlaced" -> 14.0 diff --git a/Source/Chatbook/Main.wl b/Source/Chatbook/Main.wl index 33d31da1..f527f1a9 100644 --- a/Source/Chatbook/Main.wl +++ b/Source/Chatbook/Main.wl @@ -14,6 +14,7 @@ BeginPackage[ "Wolfram`Chatbook`" ]; `$DefaultModel; `$DefaultToolOptions; `$DefaultTools; +`$IncludedCellWidget; `$InstalledTools; `$SandboxKernel; `$ToolFunctions; @@ -26,6 +27,7 @@ BeginPackage[ "Wolfram`Chatbook`" ]; `CurrentChatSettings; `FormatChatOutput; `FormatToolResponse; +`GetChatHistory; `GetExpressionURI; `GetExpressionURIs; `MakeExpressionURI; @@ -93,6 +95,7 @@ Block[ { $ContextPath }, Get[ "Wolfram`Chatbook`Dialogs`" ]; Get[ "Wolfram`Chatbook`ToolManager`" ]; Get[ "Wolfram`Chatbook`PersonaManager`" ]; + Get[ "Wolfram`Chatbook`ChatHistory`" ]; ]; (* ::**************************************************************************************************************:: *) @@ -115,6 +118,7 @@ Protect[ CurrentChatSettings, FormatChatOutput, FormatToolResponse, + GetChatHistory, GetExpressionURI, GetExpressionURIs, MakeExpressionURI, diff --git a/Source/Chatbook/SendChat.wl b/Source/Chatbook/SendChat.wl index c2a94edb..a87fe3f9 100644 --- a/Source/Chatbook/SendChat.wl +++ b/Source/Chatbook/SendChat.wl @@ -15,6 +15,7 @@ Begin[ "`Private`" ]; Needs[ "Wolfram`Chatbook`" ]; Needs[ "Wolfram`Chatbook`Actions`" ]; Needs[ "Wolfram`Chatbook`ChatGroups`" ]; +Needs[ "Wolfram`Chatbook`ChatHistory`" ]; Needs[ "Wolfram`Chatbook`ChatMessages`" ]; Needs[ "Wolfram`Chatbook`Common`" ]; Needs[ "Wolfram`Chatbook`Formatting`" ]; @@ -997,28 +998,6 @@ selectChatCells0[ cell_, cells: { __CellObject }, final_ ] := Enclose[ selectChatCells0 // endDefinition; -(* ::**************************************************************************************************************:: *) -(* ::Subsubsection::Closed:: *) -(*filterChatCells*) -filterChatCells // beginDefinition; - -filterChatCells[ cellInfo: { ___Association } ] := Enclose[ - Module[ { styleExcluded, tagExcluded, cells }, - - styleExcluded = DeleteCases[ cellInfo, KeyValuePattern[ "Style" -> $$chatIgnoredStyle ] ]; - - tagExcluded = DeleteCases[ - styleExcluded, - KeyValuePattern[ "ChatNotebookSettings" -> KeyValuePattern[ "ExcludeFromChat" -> True ] ] - ]; - - tagExcluded - ], - throwInternalFailure[ filterChatCells @ cellInfo, ## ] & -]; - -filterChatCells // endDefinition; - (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*deleteExistingChatOutputs*) diff --git a/Source/Chatbook/Settings.wl b/Source/Chatbook/Settings.wl index d799ddb3..a2639a37 100644 --- a/Source/Chatbook/Settings.wl +++ b/Source/Chatbook/Settings.wl @@ -7,6 +7,7 @@ BeginPackage[ "Wolfram`Chatbook`Settings`" ]; HoldComplete[ `$defaultChatSettings; `currentChatSettings; + `getPrecedingDelimiter; ]; Begin[ "`Private`" ];