Can a Style inherit CellMargins depending how it is grouped?

Question

This is a cross-post from https://community.wolfram.com/groups/-/m/t/2107710?p_p_auth=JoAd1Xpi

and is similar to How to inherit indentation in cell groups?

I'd like to have the Styles Item, Subitem, and Subsubitem indent relative to which group they are located. Here is a concrete example to explain what I mean:

CreateDocument[
 {
  Cell["This is a section", "Section"],
  Cell["This is an item in a section", "Item"],
  Cell["This is a Subitem in a section", "Subitem"],
  Cell["This is a Subsubitem in a section", "Subsubitem"],
  Cell["This is a Subsection", "Subsection"],
  Cell["This is an item in a section", "Item"],
  Cell["This is a Subitem in a Subsection", "Subitem"],
  Cell["This is a Subsubitem in a Subsection", "Subsubitem"],
  Cell["This is a Subsubsection", "Subsubsection"],
  Cell["This is an item in a Subsubsection", "Item"],
  Cell["This is a Subitem in a Subsubsection", "Subitem"],
  Cell["This is a Subsubitem in a Subsubsection", "Subsubitem"]}
 ]

Notice that the item-like styles all have the same indentation--the indentation doesn't depend on the indentation of Section, Subsection, Subsubsection...

If I edit the Stylesheet with:

Cell[StyleData["Item"],
CellMargins -> AbsoluteCurrentValue[PreviousCell[], CellMargins]+{{24,0},{0,0}}

(which is similar to the StackExhange post above), it almost works. Creating consecutive Items causes an increasing indents for each Item. What is needed is the nearest enclosing Section, Subsection, Subsubsection, etc.

I was thinking of going down the path of Nesting PreviousCell[] until the Style is a Section, Subsection,..., and then using its CurrentValue of CellMargins. Is this a bad idea? Seems it would cause a lot of round trips to the FrontEnd. It would be so much easier if there was an InheritFrom[EnclosingGroup[]] (just making up names of non-existent function here).

Is there a way to do this that I am missing?

Answer 1

Here's something you can add to your StyleDefinitions

CellDynamicExpression ->
 Dynamic[
  Block[{g, e = EvaluationCell[]},
   g = StylesheetFunctions`enclosingGroup[e];
   SetOptions[
    e, 
    {
     CellMargins -> StylesheetFunctions`getMarginsFromGroup[e],
     CellDynamicExpression -> None
     }
    ]
   ],
  TrackedSymbols :> {},
  UpdateInterval -> Infinity,
  Initialization :>
   
   If[! System`Private`HasDownCodeQ[StylesheetFunctions`enclosingGroup],
    StylesheetFunctions`getMarginsFromGroup[cell_] :=
     Replace[
      {
       If[# === None, None,
          AbsoluteCurrentValue[#, CellMargins]
          ] &@StylesheetFunctions`enclosingGroup[cell][[1]],
       AbsoluteCurrentValue[ParentNotebook[cell],
        {StyleDefinitions, CurrentValue[cell, CellStyle][[1]], CellMargins}]
       },
      {
       {
         {{l1_?NumberQ, _}, {_, _}},
         {{l2_?NumberQ, r_}, {t_, b_}}
         } :>
        {{l1 + l2, r}, {t, b}},
       {_, else_} :> else
       }
      ];
    StylesheetFunctions`enclosingGroup[
      cell_, groupingRules_ : {"SectionGrouping", "TitleGrouping"}] :=
     
     Block[
      {
       nb = ParentNotebook[cell],
       c,
       grs,
       i,
       cgr
       },
      c = Cells[nb];
      grs = CurrentValue[c, CellGroupingRules];
      i = FirstPosition[List @@ c[[;; , 1]], cell[[1]]][[1]];
      cgr = grs[[i]];
      (* take until we hit one of the groupingRules *)
      Reap[
          Catch[
           MapThread[
            If[MemberQ[groupingRules, Flatten[{#2}][[1]]],
              Sow[#];
              Throw["Done!"],
              Sow[#]
              ] &,
            Reverse /@ {
              c[[;; i]],
              grs[[;; i]]
              }
            ];
           Sow[None]
           ]
          ][[2]] // Flatten // Reverse
      ]
    ]
  ]

It's based on a core function to determine the cell group for a cell + something to easily inherit CellMargins.

StylesheetFunctions`getMarginsFromGroup[cell_] :=
  Replace[
   {
    If[# === None, None,
       AbsoluteCurrentValue[#, CellMargins]
       ] &@StylesheetFunctions`enclosingGroup[cell][[1]],
    AbsoluteCurrentValue[ParentNotebook[cell],
     {StyleDefinitions, CurrentValue[cell, CellStyle][[1]], CellMargins}]
    },
   {
    {
      {{l1_?NumberQ, _}, {_, _}},
      {{l2_?NumberQ, r_}, {t_, b_}}
      } :>
     {{l1 + l2, r}, {t, b}},
    {_, else_} :> else
    }
   ];
StylesheetFunctions`enclosingGroup[
  cell_, groupingRules_ : {"SectionGrouping", "TitleGrouping"}] :=
 Block[
  {
   nb = ParentNotebook[cell],
   c,
   grs,
   i,
   cgr
   },
  c = Cells[nb];
  grs = CurrentValue[c, CellGroupingRules];
  i = FirstPosition[List @@ c[[;; , 1]], cell[[1]]][[1]];
  cgr = grs[[i]];
  (* take until we hit one of the groupingRules *)
  Reap[
      Catch[
       MapThread[
        If[MemberQ[groupingRules, Flatten[{#2}][[1]]],
          Sow[#];
          Throw["Done!"],
          Sow[#]
          ] &,
        Reverse /@ {
          c[[;; i]],
          grs[[;; i]]
          }
        ];
       Sow[None]
       ]
      ][[2]] // Flatten // Reverse
  ]

Or if you just want to directly get the cells to embed in your sheet

CellPrint[
    Cell[
     StyleData[#],
     CellDynamicExpression ->
      Dynamic[
       Block[{g, e = EvaluationCell[]},
        g = StylesheetFunctions`enclosingGroup[e];
        SetOptions[
         e, 
         {
          CellMargins -> StylesheetFunctions`getMarginsFromGroup[e],
          CellDynamicExpression -> None
          }
         ]
        ],
       TrackedSymbols :> {},
       UpdateInterval -> Infinity,
       Initialization :>
        
        If[! System`Private`HasDownCodeQ[StylesheetFunctions`enclosingGroup],
         StylesheetFunctions`getMarginsFromGroup[cell_] :=
          Replace[
           {
            If[# === None, None,
               AbsoluteCurrentValue[#, CellMargins]
               ] &@StylesheetFunctions`enclosingGroup[cell][[1]],
            AbsoluteCurrentValue[ParentNotebook[cell],
             {StyleDefinitions, CurrentValue[cell, CellStyle][[1]], CellMargins}]
            },
           {
            {
              {{l1_?NumberQ, _}, {_, _}},
              {{l2_?NumberQ, r_}, {t_, b_}}
              } :>
             {{l1 + l2, r}, {t, b}},
            {_, else_} :> else
            }
           ];
         StylesheetFunctions`enclosingGroup[
           cell_, groupingRules_ : {"SectionGrouping", "TitleGrouping"}] :=
    
                Block[
           {
            nb = ParentNotebook[cell],
            c,
            grs,
            i,
            cgr
            },
           c = Cells[nb];
           grs = CurrentValue[c, CellGroupingRules];
           i = FirstPosition[List @@ c[[;; , 1]], cell[[1]]][[1]];
           cgr = grs[[i]];
           (* take until we hit one of the groupingRules *)
           Reap[
               Catch[
                MapThread[
                 If[MemberQ[groupingRules, Flatten[{#2}][[1]]],
                   Sow[#];
                   Throw["Done!"],
                   Sow[#]
                   ] &,
                 Reverse /@ {
                   c[[;; i]],
                   grs[[;; i]]
                   }
                 ];
                Sow[None]
                ]
               ][[2]] // Flatten // Reverse
           ]
         ]
       ]
     ]
    ] & /@ {"Input", "Output", "Text"};

Note that I added the line

CellDynamicExpression -> None

to turn this off after it applies. That's just for performance as you edit. If you need to refresh the margins (say you changed some grouping around) you can do it like so:

FrontEndExecute@
  Map[FrontEnd`SetOptions[#, CellDynamicExpression -> Inherited] &, Cells[]];

Of course, if you just want to style after you've built your NB you can do so faster/more easily than I did here by just scanning through the info in Developer`CellInformation[Cells[]].

Answer 2

This could also be done in one or more batches. The following creates a document with a button to style the "Items" kind of cells. It also put "Text" cells at the level of Item. Adding to the document requires clicking the button again.

buttonFunc[] :=
 (setItemMargins[cell_] := (
    currentItemMargin = 0;
    absOpt = NotebookRead[cell][[2]];
    Which[absOpt == "Section", lastMargin = sectionMargin; Return[], 
     absOpt == "Subsection", lastMargin = subsectionMargin; Return[], 
     absOpt == "Subsubsection", lastMargin = subsubsectionMargin; 
     Return[], absOpt == "Item", currentItemMargin = itemMargin, 
     absOpt == "Subitem", currentItemMargin = subitemMargin, 
     absOpt == "Subsubitem", currentItemMargin = subsubitemMargin, 
     absOpt == "Text", currentItemMargin = itemMargin - 15];
    
    SetOptions[cell, 
     CellMargins -> {{currentItemMargin + lastMargin - sectionMargin, 
        Inherited}, {Inherited, Inherited}}];
    );
  lastMargin = 0;
  sectionMargin = 27;
  subsectionMargin = 50;
  subsubsectionMargin = 66;
  itemMargin = 81;
  subitemMargin = 105;
  subsubitemMargin = 129;
  sm = setItemMargins /@ 
    Cells[nb, 
     CellStyle -> {"Section", "Subsection", "Subsubsection", "Item", 
       "Subitem", "Subsubitem", "Text"}];)

nb = CreateDocument[{
    Button["Style document", buttonFunc[]],
    Cell["This is a section", "Section"],
    Cell["This is text in a section", "Text"],
    Cell["This is an item in a section", "Item"], 
    Cell["This is a Subitem in a section", "Subitem"], 
    Cell["This is a Subsubitem in a section", "Subsubitem"], 
    Cell["This is a Subsection", "Subsection"],
    Cell["This is text in a Subsection", "Text"], 
    Cell["This is an item in a subsection", "Item"], 
    Cell["This is a Subitem in a Subsection", "Subitem"], 
    Cell["This is a Subsubitem in a Subsection", "Subsubitem"], 
    Cell["This is a Subsubsection", "Subsubsection"],
    Cell["This is text in a Subsubsection", "Text"],
    Cell["This is an item in a Subsubsection", "Item"], 
    Cell["This is a Subitem in a Subsubsection", "Subitem"], 
    Cell["This is a Subsubitem in a Subsubsection", "Subsubitem"]}];
```