Problem with SelectionMove in stylesheets

Question

I would like to design a cell style, for inclusion in a stylesheet, having the following characteristics:

1. It should be a cascade descendant of Text, called here FactoidText
2. When a FactoidText cell is created, it should look exactly like a TextCell (that is, it should be empty) except that its contents should be surrounded by "{Factoid: " and "}"
3. The typing cursor should be placed just to the right of the space after the colon
4. "{Factoid: " and "}" should not be editable
5. I wish to avoid solutions with CellFrame and with CellDingbat

An example of use would be the following:

{Factoid: Isaac Newton invented the pet door, which he called a "cat flap".}

I have made good progress building this style cell but run into a problem with requirement #3, placing the typing cursor. Here is the style definition I have constructed:

Cell[
StyleData["FactoidText", StyleDefinitions -> StyleData["Text"]], 
 CellDynamicExpression :> (
  SetOptions[EvaluationCell[], CellDynamicExpression -> None]; 
  SelectionMove[EvaluationNotebook[], After, CellContents, 
    AutoScroll -> False];
  NotebookWrite[
   EvaluationNotebook[], 
   TextData[
    StyleBox["{Factoid: ", FontWeight -> Bold, Editable -> False]]
  ];
  NotebookWrite[
   EvaluationNotebook[], 
   TextData[
    StyleBox["\[SelectionPlaceholder]", FontColor -> Red, 
      FontWeight -> Plain, Editable -> True]]
  ];
  NotebookWrite[
   EvaluationNotebook[], 
   TextData[
    StyleBox["}", FontColor -> Black, FontWeight -> Bold, 
      Editable -> False]]
  ];
  SelectionMove[EvaluationNotebook[], After, CellContents, 
    AutoScroll -> False];
 ),
 MenuSortingValue -> 101
]

(Note that in the above style definition, the SelectionPlaceholder and the Red styling are there for debugging/visibility purposes and are not part of the requirements.)

When I place the above FactoidText cell in a Notebook's stylesheet and create a FactoidText cell, I see the desired content, but the cursor is not placed correctly. If the creation is initiated from the inter-cell (Choose a new cell type) dropdown, the cursor is placed just before the "{" in "{Factoid: ". If instead, the cell creation is initiated from the Format/Text menu, the cursor is placed after the closing "}".

There are two other small anomalies that I have not been able to fix. 1) If I manually place the cursor before the SelectionPlaceholder and enter some text, the text comes out in bold black rather than in Red. 2) In the same circumstances the typed text can't be deleted. If instead I type after the SelectionPlaceholder, the text is Red and can be successfully deleted, as expected.

Note that I am able to successfully move the insertion point using SelectionMove from the Notebook interface as demonstrated with these expressions:

nb = CreateDocument[{Cell["Text 1"], Cell["Text 2"], Cell["Text 3"]}];
Row[{
  Button["Next", SelectionMove[nb, Next, Cell]], 
  Button["Previous", SelectionMove[nb, Previous, Cell]], 
  Button["After", SelectionMove[nb, After, Cell]], 
  Button["Before", SelectionMove[nb, Before, Cell]]
}]

I have tried various alternative approaches using other SelectionMove parameters and TemplateBoxes, without success. I feel that others must have developed similar "enclosed" styles, but this is my first attempt with stylesheets, so I welcome any suggestions.

I am running MMA version 13.2.1.0 on a MacBook M2 Pro, with Ventura 13.2.1. This is the only style cell in the spreadsheet.

Answer 1

I would approach the problem by using TemplateBox for the wrapper text, together with the following:

Cell[
  StyleData["FactoidText", StyleDefinitions -> StyleData["Text"]],
  CellDynamicExpression:>(NotebookWrite[
    EvaluationCell[], 
    Cell[
     BoxData[
      TemplateBox[{
        Replace[NotebookRead[EvaluationCell[]],{Cell["","FactoidText"]->"\[Placeholder]",cell_:>Cell[First[cell],"Text","Text"]}]
      }, ""]], "FactoidTextHelper"], All]; 
  FrontEndTokenExecute[EvaluationNotebook[], "MovePrevious"]; 
  FrontEndTokenExecute[EvaluationNotebook[], "MovePrevious"];),
  MenuSortingValue->10000
 ]

Cell[
 StyleData["FactoidTextHelper", StyleDefinitions -> StyleData["Text"]],
 Selectable -> False,
 TemplateBoxOptions -> {
   DisplayFunction -> (RowBox[{"{Factoid:", 
        StyleBox[#, Selectable -> True], "}"}] &),
   BaseStyle -> "Text"
   },
 StyleMenuListing -> None
]

Notes:

• This uses the fact that for TemplateBox, the default editing behavior is exactly what we want: We can edit the placeholder content, but not the TemplateBox itself
• I make the cell contents themselves unselectable, and only enable it selectively for the user content
• I use All in NotebookWrite to have a controlled starting point for the selection (namely the entire cell), from which I can move to the placeholder using two "MovePrevious" actions (this is equivalent to pressing the left arrow key twice). Ideally, I would have used Placeholder as the target selection for NotebookWrite, but that doesn't work for me for some reason
• I use a helper style "FactoidTextHelper" for the actual styling. The main style only created the necessary cell contents. This makes sure that the CellDynamicExpression is only triggered once (since the cell style is different after the initial evaluation), otherwise it's very easy to trigger infinite loops.