2
$\begingroup$

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?

$\endgroup$
5
  • $\begingroup$ I don't think any sense of EnclosingGroup is exposed in any part of the FE that I've seen, but in terms of efficient implementation of this, I'd recommend getting the cell styles via something like With[{c=Cells[], this=EvaluationCell[]}, With[{s=CurrentValue[c, CellStyle]}, ...]] since that's only 3 round-trips to the FE. It seems more wasteful since you always pull every cell, but the CellObject has a small memory footprint and so at the end of the day it will probably be faster $\endgroup$ – b3m2a1 Nov 12 '20 at 3:18
  • $\begingroup$ Why can't you use PreviousCell[CellStyle -> "Subsection" | "Section"]? $\endgroup$ – Carl Woll Nov 12 '20 at 19:31
  • $\begingroup$ @CarlWoll Yikes, I didn't see that option. Palm slap to forehead and note to myself: read the doc. Thanks. $\endgroup$ – Craig Carter Nov 14 '20 at 12:30
  • $\begingroup$ @CarlWoll Interesting. The Stylesheet editor won't accept alternatives. That is, shift-cmd-E won't close the cell if the expression has alternatives. In other words: PreviousCell[CellStyle -> "Subsection" | "Section"] isn't accepted by the sylesheet editor, while PreviousCell[CellStyle -> "Subsection" | "Section"] works. $\endgroup$ – Craig Carter Nov 15 '20 at 20:49
  • $\begingroup$ It works if I use Alternatives["Section","Subsection"]. Perhaps this is a buglet in the stylesheet editor. $\endgroup$ – Craig Carter Nov 15 '20 at 21:00
1
$\begingroup$

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[]].

enter image description here

$\endgroup$
1
  • $\begingroup$ I haven't had a chance to try this yet---but wanted to send my thanks for what looks like a serious investment of time. Will implement soon. $\endgroup$ – Craig Carter Nov 14 '20 at 12:22
0
$\begingroup$

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"]}];
```
$\endgroup$
1
  • $\begingroup$ Thank you @Jean-Pierre. I'll try this implementation soon. It looks like this could be generalized for other purposes as well. $\endgroup$ – Craig Carter Nov 14 '20 at 12:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.