Maintaining stylesheet information in Cell[]

Question

I am working on formatting a cell for a slideshow presentation format such that a graphics object occupies the left half of the cell and bullets or other items occupy the right. The ancient AuthorTools functions are not sufficiently documented for me to determine if this is possible with bilateral cells, but the first attempt below is my stripped down version of ToBilateral

CellPrint@Cell[BoxData@GridBox[
    {{
      Cell[BoxData[ToBoxes[Plot[Sin[x], {x, 0, 2 Pi}]]], "Output"],
      GridBox[{
        {Cell["section", "Section"]},
        {Cell["subsection", "Subsection"]},
        {Cell["item", "Item"]}
        }, ColumnAlignments -> Left]
      }}, ColumnSpacings -> 3, RowAlignments -> Top]]

gives the following output with the default stylesheet

Boxing in Mathematica can leave you punch drunk very quickly, so I reverted to Row and Column to get this

Row[
 {Plot[Sin[x], {x, 0, 2 Pi}, ImageSize -> 300],
  Column[{
    Style["section", "Section"],
    Style["subsection", "Subsection"],
    Style["item", "Item"]
    }, Left, 2]
  }, "\t"]

In both cases the dingbat for the item style gets eaten and there is no style indenting. I attempted to edit the stylesheet and navigate to the options inspector; however changes made there have no effect on the output of either of these code snippets unless the formatting change is related to font color, size, weight, etc. Oddly enough, the framestyle for a section does appear in the Cell snippet but not in the Row/Column snippet.

To be clear, I'm looking for something like this:

which I've only been able to obtain with the following code:

LoadMicrosoftPowerPoint[]
CutandPaste[]

so I'm looking for a better solution.

Answer 1

Here's what I've come up with so far to address this problem. Ultimately, I want two columns where one column is a set of bullets and the other column is any type of object. I have a hack of a solution by making two functions. The first makes bullets and the second makes the two columns. Please pardon the code:

Clear[bulletbox]
bulletbox[s_List] := Module[{
   t, bul = {"+ ", "- ", "~ "}, 
   level = 1 + (Max@StringPosition[#, "$"] & /@ 
        s /. {-\[Infinity] -> 0}),
   style = {"Section", "Subsection", "Subsection", "Item"}
   },
  t = MapThread[StringInsert[#1, bul[[#2]], #2] &, {s, level}];
  t = Map[StringReplace[#, "$" -> "\t"] &, t];
  t = MapThread[Style[#1, style[[#2]]] &, {t, level}];
  t = GridBox[{Map[Cell[#, TabSpacings -> {2}] &, t]} // Transpose, 
    ColumnAlignments -> Left];
  t
  ]

Clear[twocol];
twocol[left_, right_] := Module[{lmod, rmod},
  rmod = right;
  lmod = If[left[[0]] === Cell, left, Cell[BoxData[ToBoxes[left]]]];

  CellPrint@
   Cell[BoxData@GridBox[{{
        lmod,
        rmod
        }}, ColumnSpacings -> 3, RowAlignments -> Top], 
    CellMargins -> {{50, 3}, {4, 4}}]]

The bullet function grabs the formatting options of the stylesheet for sections and subsections so hopefully the bullets maintain some type of style consistency with the rest of the notebook. Results look like:

twocol[Manipulate[Plot[Sin[a x], {x, 0, 2 Pi}], {a, 1, 10}], 
 bulletbox[{"A Manipulate tool", "$interactive graphics", 
   "$$Easy to make", "Two column output", "$Desired feature", 
   "$$Nontrivial to make"}]]

Perhaps the biggest problem with this approach is that cells generated using this function don't seem to like SEUploader! (and those of you paying attention will note that I did change the bullet icons...)

Any comments would be appreciated. There is no doubt that the bulletbox function is poorly written, but I needed something since my presentation is a few days away.