Panel, Pane, and Framed Alignment - Clipped Images, Negative Margins, ContentPadding

Question

I'm trying to tightly wrap some expressions in containers (could be Panel, Pane, maybe Framed in some cases -- it varies on the use-case) the way a normal expression cell's frame are laid-out.

That is, if you select a simple expression like x, you get the following:

Whereas, even with PaneMargins and ImageMargins set to 0, selecting e.g. a Pane results in this:

One way to calculate the borders/margins between the inner expression and the bounding box of the expression when placed inside a container such as Pane is using ImageBorders. That part is straightforward enough, and not the subject of this question (although I'd welcome more efficient methods than rasterizing and then using ImageBorders! EDIT: Found an alternative, see the end of this post.).

The subject of this question is: Can someone provide a general-case description, or link to documentation, for the alignment behavior of Pane, Panel, Framed, and any other bonus containers, with respect to options such as Alignment and FrameMargins? Particularly, when ImageSize is less than what would be returned by ImageSize@Rasterize@expr and FrameMargins contains negative values, I find that the resulting output between the different containers varies quite a bit.

EDIT: As suggested by Carl Woll in a comment below, setting ContentPadding->False ought to solve this question. However, I used that in my example below, and it didn't work. I believe that wrapping e.g. a Pane in e.g. a Grid causes the Pane's ContentPadding option to not be respected. Maybe that behavior is the crux of this post.

It's easier to post a GIF animation exported from Mathematica than to explain much further. On first inspection, it looks like there are two classes of containers: Pane and Row on the one hand, and Framed and Panel on the other. But if you look closely, as glyphs "scroll into the inside of each container", the behavior is different between e.g. Framed and Panel when the margins are negative. It makes getting a general-case solution tough when you're trying to tightly wrap expressions, but don't want them clipped.

Animation below:

And here is a version with the other margin dimension being animated:

REFERENCE:

The code used to generate the above plots is shown below:

MakeContainerSwatch[expr_, height_, alignment_] := 
 Module[{rulesCommon, rulesPadding, rulesFrame, rulesColor, 
   rulesColorPane, align, margins, pane1, pane2, pane3, framed1, 
   framed2, framed3, panel1, panel2, panel3, row1, row2, row3},
  rulesCommon = Sequence[
    ImageSize -> {Automatic, height},
    ImageMargins -> {{0, 0}, {0, 0}},
    BaseStyle -> "Output"
    ];
  rulesPadding = Sequence[ContentPadding -> False];
  rulesFrame = Sequence[Frame -> True];
  rulesColor = Sequence[Background -> LightBlue];
  rulesColorPane = 
   Sequence[DefaultBaseStyle -> {Background -> LightBlue}];
  align[y_] = Alignment -> {Center, y};
  margins[align_] = FrameMargins -> {{0, 0}, align};
  
  pane1 = 
   Pane[expr, rulesCommon, rulesPadding, rulesColorPane, align[-1], 
    margins[alignment]];
  pane2 = 
   Pane[expr, rulesCommon, rulesPadding, rulesColorPane, align[0], 
    margins[alignment]];
  pane3 = 
   Pane[expr, rulesCommon, rulesPadding, rulesColorPane, align[1], 
    margins[alignment]];
  
  framed1 = 
   Framed[expr, rulesCommon, rulesPadding, rulesColor, align[-1], 
    margins[alignment]]; 
  framed2 = 
   Framed[expr, rulesCommon, rulesPadding, rulesColor, align[0], 
    margins[alignment]];
  framed3 = 
   Framed[expr, rulesCommon, rulesPadding, rulesColor, align[1], 
    margins[alignment]];
  
  panel1 = 
   Panel[expr, rulesCommon, rulesPadding, rulesColor, align[-1], 
    margins[alignment]];
  panel2 = 
   Panel[expr, rulesCommon, rulesPadding, rulesColor, align[0], 
    margins[alignment]];
  panel3 = 
   Panel[expr, rulesCommon, rulesPadding, rulesColor, align[1], 
    margins[alignment]];
  
  row1 = Row[{expr}, rulesCommon, rulesFrame, rulesColor, align[-1], 
    margins[alignment]];
  row2 = Row[{expr}, rulesCommon, rulesFrame, rulesColor, align[0], 
    margins[alignment]];
  row3 = Row[{expr}, rulesCommon, rulesFrame, rulesColor, align[1], 
    margins[alignment]];
  
  {"pn", pane1, pane2, pane3, "fr", framed1, framed2, framed3, "pl", 
   panel1, panel2, panel3, "rw", row1, row2, row3}
  ]

sampleExpression = "a\nb\nc\nd\ne\nf\ng\nh";

dummyPane1 = Pane["*", BaseStyle -> "Output"];
dummyPane2 = Pane["*\n*\n*\n*\n*\n*\n*\n*\n", BaseStyle -> "Output"];

containerSwatch := With[
  {
   bottomLabel = StringTemplate["Bottom: `bot`"][<|"bot" -> bot|>],
   topLabel = StringTemplate["Top: `top`"][<|"top" -> top|>]
   },
  Grid[List /@ {
     Row@{
       Panel[
        ParametricPlot[{bot, y}, {y, 0, 10}, 
         PlotRange -> {{-40, 40}, {0, 10}}, PlotLabel -> bottomLabel, 
         Axes -> {True, False}, ImageSize -> Medium],
        ImageSize -> Scaled[0.49], Alignment -> Center],
       Panel[
        ParametricPlot[{top, y}, {y, 0, 10}, 
         PlotRange -> {{-40, 40}, {0, 10}}, PlotLabel -> topLabel, 
         Axes -> {True, False}, ImageSize -> Medium],
        ImageSize -> Scaled[0.49], Alignment -> Center]
       },
     Grid@List@{
        StyleHeading["Clipped: "],
        Splice@
         Prepend[dummyPane2]@
          MakeContainerSwatch[sampleExpression, 
           154 - 80, {bot, top}],
        StyleHeading[", Oversized: "],
        Splice@
         Prepend[dummyPane2]@
          MakeContainerSwatch[sampleExpression, 154 + 80, {bot, top}]
        }
     },
   ItemSize -> Full
   ]
  ]
containerSwatchAnimation1 = 
  Table[containerSwatch, {top, -40, 40, 20}, {bot, -40, 40, 2}];
containerSwatchAnimation2 = 
  Table[containerSwatch, {bot, -40, 40, 20}, {top, -40, 40, 2}];
Export["containerSwatchAnimation1.gif", 
 Flatten@containerSwatchAnimation1, ImageResolution -> 72/2]
Export["containerSwatchAnimation2.gif", 
 Flatten@containerSwatchAnimation2, ImageResolution -> 72/2]

EDIT: For posterity, here is a fast way to get the size you'd need to use to make a tightly-wrapped container. Credit goes to this post by b3m2a1: https://mathematica.stackexchange.com/a/166772/76328

FrontEndExecute@
 GetBoundingBoxSizePacket@
  Cell[
   BoxData["aaaaaaa\na\na\na\na" // ToBoxes],
   "Output",
   PageWidth -> Infinity,
   ShowCellBracket -> False,
   CellMargins -> {{0, 0}, {0, 0}}
   ]

It's not the same as using ImageRaster and then the combination of ImageDimensions and BorderDimensions, but it's so much faster, and if I get the ContentPadding option (noted by Carl Woll below) working with Grids, it'll be sufficient for my task-at-hand (a ragged Grid of Rows of Panes of alternating colors, where the Rows are expected to line-wrap, but you want the Panes to be the same height for aesthetics).

Answer 1

Thanks again Carl Woll for the push in the right direction with pursuing ContentPadding further. It turns out that ContentPadding does allow using a Framed/Pane to tightly wrap an expression, including within a Grid, if you have a couple settings specified.

Solution:

First, I needed to specify Spacings->{0,0} explicitly, instead of using Spacings->0. Easy to get this wrong... Secondly, to specify a minimum item size, you simply use ItemSize directly; that is, use ItemSize->{0,0}! ItemSize behaves differently than what we may be accustomed to with ImageSize in other uses. At least for a Grid, a setting of {0,0} does not mean "the item's size is nothing", it means that the item's minimum size is nothing.

The working code follows:

testPane[expr_] := Pane[Style[expr, Red],
   ImageMargins -> {{1, 1}, {1, 1}},
   FrameMargins -> {{0, 0}, {0, 0}},
   ContentPadding -> False
   ];

testFramed[expr_] := Framed[Style[expr, Red],
   ImageMargins -> {{0, 0}, {0, 0}},
   FrameMargins -> {{0, 0}, {0, 0}},
   ContentPadding -> False
   ];

testTable[obj_] := Table[obj, {i, 1, 3}, {j, 1, 3}];

(* ItemSize ITSELF *IS* the MINIMUM item size *)
(* -- don't need to search for another option *)
testGrid[table_] := Grid[
  table,
  Frame -> All,
  Spacings -> {0, 0},
  ItemSize -> {0, 0}
  ]

Magnify[testGrid[testTable[testPane["a"]]], 5]
Magnify[testGrid[testTable[testFramed["a"]]], 5]

Magnify[testGrid[testTable[testPane[_]]], 5]
Magnify[testGrid[testTable[testFramed[_]]], 5]

Magnify[testGrid[testTable[testFramed["_jQ\""]]], 5]
Magnify[testGrid[testTable[testPane["_jQ\""]]], 5]

Magnify[testPane[_], 5]
Magnify[testFramed[_], 5]

Output:

Alternative:

To be thorough, I also pursued my other path, where I was trying to use negative margins to allow tight wrapping of an expression. The crux of this method is coming up with ways to get the dimensions of an expression in the first place. I came up with three methods, which may be useful for others. I think that the slow Rasterize-based method is the only one that would do better than using ContentPadding (e.g. ContentPadding falls a bit short when you have very small expressions, like the _ example shown above). I included AbsoluteTiming information with each method.

At a high-level, and for keyword searching, the methods used were:

• Rasterize, ImageDimensions, BorderDimensions, and ImageCrop
• FrontEndExecute@ExportPacket[..., "BoundingBox"]
• FrontEndExecute@GetBoundingBoxSizePacket@...
• CellPrint, CellTags, and AbsoluteOptions

Alternative 1 - Raster-based method:

SetAttributes[RasterizeSwatch, HoldAllComplete]

RasterizeSwatch[expr_] :=
 
 Module[{imageSizeToPixelsCorrection, rasterRaw, dimsRasterRaw, 
   borderRasterRaw, dimsRasterRawNet, rasterCrop, dimsRasterCrop, 
   dimsRasterDirect, header1, header2, swatch},
  
  imageSizeToPixelsCorrection = 
   First["Scale" /. CurrentValue["ConnectedDisplays"]];
  
  (* Method 1 *)
  rasterRaw := Rasterize@HoldForm@expr;
  dimsRasterRaw := 
   ImageDimensions@rasterRaw/imageSizeToPixelsCorrection;
  borderRasterRaw := 
   BorderDimensions@rasterRaw/imageSizeToPixelsCorrection;
  (*dimsRasterRawNet:=Subtract@@{dimsRasterRaw,Map[Apply[Plus]]@
  borderRasterRaw};*)
  
  dimsRasterRawNet := dimsRasterRaw - Apply[Plus] /@ borderRasterRaw;
  
  (* Method 2 *)
  rasterCrop := ImageCrop@rasterRaw;
  dimsRasterCrop := 
   ImageDimensions@rasterCrop/imageSizeToPixelsCorrection;
  
  (* Method 3 *)
  
  dimsRasterDirect := 
   Rasterize[expr, "BoundingBox"]/imageSizeToPixelsCorrection;
  
  header1 = {Style["Raster-based Expression Size Info", Bold], 
    SpanFromLeft};
  header2 = Style[#, Bold] & /@ {"Operation", "Result", "Timing: 20x"};
  swatch = {
    header1,
    header2,
    {"rasterRaw", 
     FramedNoMargins@Image[rasterRaw, Magnification -> 2], 
     rasterRaw // TimeSequential[20]},
    {"dimsRasterRaw", dimsRasterRaw, rasterRaw = rasterRaw; 
     dimsRasterRaw // TimeSequential[20]},
    {"borderRasterRaw", borderRasterRaw, 
     borderRasterRaw // TimeSequential[20]},
    {"dimsRasterRawNet", dimsRasterRawNet, 
     dimsRasterRawNet // TimeSequential[20]},
    {"rasterCrop", 
     FramedNoMargins@Image[rasterCrop, Magnification -> 2], 
     rasterCrop // TimeSequential[20]},
    {"dimsRasterCrop", dimsRasterCrop, 
     dimsRasterCrop // TimeSequential[20]},
    {"dimsRasterDirect", dimsRasterDirect, 
     dimsRasterDirect // TimeSequential[20]}
    };
  
  Grid[swatch, Frame -> All, ItemSize -> Full, 
   Alignment -> {Center, Center}]
  ]

Alternative 2 - FrontEndExute Method:

FormatExportPacketBoundingBox[obj_] := 
 Grid[#, Frame -> All] &@{{Null, "Width", "Height"}, 
     Prepend[#[[1, 2]] - #[[1, 1]], "Net"], 
     Prepend[#[[1, 1]], "Padding"], 
     Prepend[#[[1, 2]], "Padded"], {"Baseline", #[[2]], 
      SpanFromLeft}} &@
  FrontEndExecute@ExportPacket[obj, "BoundingBox"]

Button["ExportPacket - BoundingBox", 
 Print@Style[#, "Output"] &@
  FormatExportPacketBoundingBox@NotebookSelection[]]

FormatGetBoundingBoxSizePacket[obj_] := 
 Grid[#, Frame -> All] &@
    Prepend[{"Width", "Baseline", "Height", "Net Height"}]@
     List@Append[#, #[[2]] + #[[3]]] &@
  First@FrontEndExecute@GetBoundingBoxSizePacket@obj

Button["GetBoundingBoxSizePacket", 
 Print@Style[#, "Output"] &@
  FormatGetBoundingBoxSizePacket@NotebookSelection[]]

FrontEndExecuteSwatch[expr_, frontEndFunction_, cellOpts___] :=
 
 Module[{exprHeldWithPane, boxes, boxesWithPane, cellFromBoxes, 
   cellFromBoxesWithPane, header1, header2, HideRules, swatch},
  
  exprHeldWithPane = PaneNoMarginsHeld@expr;
  
  boxes := ToBoxes@Unevaluated@expr;
  (*boxesWithPane=Replace[Unevaluated@ToBoxes@exprHeldWithPane,Hold[
  x_]\[Rule]HoldComplete@x,{1}];*)(*
  boxesWithPane=ToBoxes@Replace[
  exprHeldWithPane,Hold[x_]\[Rule]Unevaluated@x,{0}];*)
  
  boxesWithPane = 
   With[{x = Unevaluated @@ exprHeldWithPane}, ToBoxes@x];
  
  cellFromBoxes := Cell[BoxData@boxes, cellOpts];
  cellFromBoxesWithPane = Cell[BoxData@boxesWithPane, cellOpts];
  
  header1 = {Style[frontEndFunction, Bold], SpanFromLeft, 
    SpanFromLeft, SpanFromLeft, SpanFromLeft};
  header2 = 
   Style[#, Bold] & /@ {"Step", "FullForm", "Displayed", 
     "Expression Size Info", "Timing: 20x"};
  
  HideRules[obj_] := 
   obj /. PaneOrPaneBox_[x__, y__Rule] -> 
     PaneOrPaneBox[x, RulesNotShown];
  
  swatch = {
    header1
    , header2
    , {"expr", HoldForm@FullForm@expr, HoldForm@expr, "N/A", "N/A"}
    , {"exprHeldWithPane", 
     HideRules@exprHeldWithPane /. Hold[x_] -> HoldForm@FullForm@x, 
     exprHeldWithPane /. Hold[x_] -> HoldForm@x, "N/A", "N/A"} (* 
    Replace with HoldForm, 
    but only after I fix the boxesWithPane issue *)
    , {"boxes", 
     FullForm@boxes, RawBoxes@boxes, "N/A", "N/A"}
    , {"boxesWithPane", HideRules@FullForm@boxesWithPane, 
     RawBoxes@boxesWithPane, "N/A", "N/A"}
    , {"cellFromBoxes", FullForm@cellFromBoxes, 
     RawBoxes@cellFromBoxes, frontEndFunction@cellFromBoxes, 
     frontEndFunction@cellFromBoxes // TimingTest[20]}
    , {"cellFromBoxesWithPane", 
     HideRules@FullForm@cellFromBoxesWithPane, 
     RawBoxes@cellFromBoxesWithPane, 
     frontEndFunction@cellFromBoxesWithPane, "N/A"}
    };
  
  Print@Style["CellPrint: cellFromBoxes", "Output"];
  CellPrint@cellFromBoxes;
  
  Print@Style["CellPrint: cellFromBoxesWithPane", "Output"];
  CellPrint@cellFromBoxesWithPane;
  
  g = Grid[swatch, Frame -> All, Alignment -> {Center, Center}(*,
    ItemSize\[Rule]{{Automatic,2\[Rule]Scaled[.4]},Automatic}*)];
  Style[g, "Output"] (* replace with just returning it *)
  ]

You can also issue FrontEndExecute with a list of ExportPacket results, which I read was supposed to be considerably quicker, but the timing looked to be within round-off error to me:

FrontEndExecute@Thread@ExportPacket[#, "BoundingBox"] &@
  Table[Cell@BoxData@ToBoxes[x + y/2], {i, 1, 20}] // AbsoluteTiming

Alternative 3 - CellSize Method:

GetCellSize = Function[expr,
   Module[{cell, GetCellSizeTag},
    (* Can alternatively use an ExpressionCell *)
    
    cell[cellOpen_] := Cell[
      BoxData@
       With[{x = Unevaluated @@ PaneNoMarginsHeld[expr]}, ToBoxes@x]
      , "Output"
      , CellTags -> SymbolName@GetCellSizeTag
      , CellElementSpacings -> {"CellMinHeight" -> 0, 
        "ClosedCellHeight" -> 0}
      , CellMargins -> -2
      , CellFrame -> 0
      , ShowCellBracket -> False
      , Background -> LightRed
      , CellOpen -> cellOpen
      ];
    cellSize := 
     CellSize /. 
      AbsoluteOptions@
       First@Cells[CellTags -> SymbolName@GetCellSizeTag];
    
    Print@Style["GetCellSize - Unhidden CellPrint:", "Output", Bold];
    CellPrint@cell[True];
    
    Grid[
     {
      {Style["GetCellSize", Bold], SpanFromLeft},
      {"Width", "Height"},
      cellSize,
      {"Timing: 20x", SpanFromLeft},
      {(CellPrint@cell[False]; cellSize) // TimingTest[20], 
       SpanFromLeft}
      },
     Frame -> All, Alignment -> {Center, Center}
     ]
    ]
   , HoldAllComplete
   ];

Usage:

RasterizeSwatch[1 + 1/2]
FrontEndExecuteSwatch[1 + 1/2, FormatExportPacketBoundingBox, "Output"]
FrontEndExecuteSwatch[
 1 + 1/2, FormatGetBoundingBoxSizePacket, "Output"]
GetCellSize[1 + 1/2]

Results:

I owe some credits to other StackOverflow posts for each of the three alternatives listed above; I'll come back and add some edits with links to the source posts, assuming I can find them.

Utility Methods used above:

TimingTest[iMax_] = 
  Function[expr, 
   Do[expr, {i, 0, iMax}] // AbsoluteTiming // First // 
    NumberForm[#, {Infinity, 3}] &, HoldAllComplete];
TimeSequential[iMax_] = 
  Function[expr, (Do[expr, {i, 0, iMax - 1}]; expr = expr) // 
      AbsoluteTiming // First // NumberForm[#, {Infinity, 3}] &, 
   HoldAllComplete];

FramedNoMargins[expr_] := 
 Framed[expr, ImageMargins -> 0, FrameMargins -> 0, 
  ContentPadding -> False]
PaneNoMargins[expr_] := 
 Pane[expr, ImageMargins -> 0, FrameMargins -> 0, 
  ContentPadding -> False, 
  BaseStyle -> {Background -> Directive[Blue, Opacity[.3]]}]
PaneNoMarginsHeld = 
  Function[expr, Evaluate@Hold@Evaluate@PaneNoMargins@expr, 
   HoldAllComplete];