8
$\begingroup$

When answering this question, I suddenly realized that it is surprisingly difficult to determine the current width of the output cell contents.

I tried to employ the ResourceFunction "GraphicsInformation" as follows:

cellAreaWidth = 
 First["ImageSize" /. 
   ResourceFunction["GraphicsInformation"][Graphics[{}, ImageSize -> Full]]]
630.75

However, experimentation by trial and error shows that the returned value is always significantly larger than the actual value, what can be due to the following reasons:

  1. The invisible Notebook window (which ExportPacket creates under the hood) has no frame and no vertical scroll bar.*

  2. The Cell where the Graphics object is placed isn't a member of a CellGroup, and hence the cell bracket is single, not double.

Also, I tried to calculate the cell area width from the documented option values:

cellAreaWidth = 
 AbsoluteCurrentValue[EvaluationNotebook[], WindowSize][[1]] - 
  Tr[Total[AbsoluteCurrentValue[EvaluationCell[], #] & /@ 
       {CellMargins, CellFrameMargins, CellLabelMargins}][[1]]] - 
  Total[{"Margins", "Thickness", "Widths"} /. 
    Options[EvaluationCell[], CellBracketOptions][[1, 2]], 2]
617.5

The obtained value seems to be very close to the actual value. But then I realized, that AbsoluteCurrentValue[EvaluationNotebook[], WindowSize] returns the full window size, which includes the space taken by the window frame and the vertical scroll bar (and I have no idea how to determine them).* Also, I'm not sure that the space taken by the cell bracket should actually be calculated as the sum of "Margins", "Thickness" and "Widths". And third, the calculated cell bracket width should be multiplied by two, because a generated "Output" cell normally has two cell brackets (because by default it is grouped with the parent "Input" cell). But in this case I get a lesser value.

So, I'm in a confusion.

How to determine the current width of the internal area of an "Output" cell (which is a member of a cell group)?

For tesing, I used the following setup (change the window width, evaluate and check whether the contents of Pane is formatted exactly the same as the contents of the generated "Output" cell):

cellContentsWidth = 
 AbsoluteCurrentValue[EvaluationNotebook[], WindowSize][[1]] - 
  Tr[Total[AbsoluteCurrentValue[EvaluationCell[], #] & /@ {CellMargins, CellFrameMargins, 
       CellLabelMargins}][[1]]] - 
  2 Total[{"Thickness",(*"Margins",*)"Widths"} /. 
     AbsoluteOptions[EvaluationCell[], CellBracketOptions][[1, 2]], 2]

lst = ResourceFunction["CreateSortableUniqueID"][20]

Pane[lst, ImageSize -> {cellContentsWidth, Automatic}, ImageSizeAction -> "ShrinkToFit", 
 FrameMargins -> None]

* According to the Documentation page for WindowSize,

The setting for WindowSize specifies the size of the content area of the window, excluding any frame.

But this statement is clearly false, because when the Notebook window is maximized (using the Maximize button on the window's title bar), its width from WindowSize is exactly equal to the width of the "Region" of the current display:

"Region" /. SystemInformation["Devices", "ConnectedDisplays"]
AbsoluteCurrentValue[EvaluationNotebook[], WindowSize]
{{{0., 1920.}, {0., 780.}}}
{1920., 747.75}

Checking shows that WindowSize doesn't depend on the presence of WindowFrame, WindowFrameElements and WindowElements:

ws1 = AbsoluteCurrentValue[EvaluationNotebook[], WindowSize][[1]];
SetOptions[EvaluationNotebook[], WindowFrame -> "Frameless", WindowFrameElements -> {}, 
  WindowElements -> {}];
ws2 = AbsoluteCurrentValue[EvaluationNotebook[], WindowSize][[1]];
SetOptions[EvaluationNotebook[], WindowFrame -> Inherited, 
  WindowFrameElements -> Inherited, WindowElements -> Inherited];
ws1 == ws2
True
$\endgroup$
3

4 Answers 4

5
$\begingroup$

Below is one approach that seems to work, apart from being off by the same 4 printers points as one of the other answers. The key advantage is that it returns the actual size of the current output cell and doesn't require any helper notebook.

DynamicModule[
 {cellSize},
 Dynamic@Pane[cellSize, ImageSize -> Full],
 Initialization :> SetOptions[
   EvaluationCell[],
   CellDynamicExpression -> Dynamic[
     AbsoluteCurrentValue@WindowSize;
     cellSize = AbsoluteCurrentValue@CellSize
     ]
   ]
 ]

enter image description here

Some notes & remaining questions/issues:

  • I am using Pane[...,ImageSize->Full] to make force the cell to take up the full width. Any other strategy to make the cell fill the entire width will also work, and if it is removed, the smaller size of the "shrink-wrapped" cell is returned
  • What's up with the offset of 4?
  • I couldn't get AbsoluteCurrentValue@CellSize to work anywhere besides CellDynamicExpression, even AbsoluteCurrentSize[EvaluationCell[], CellSize] doesn't seem to work
  • Some kind of manual force-refreshing is required. What form this takes depends on the application. Above, I am calling AbsoluteCurrentValue@WindowSize to make the dynamic expression refresh whenever the window size changes. Of course, this might not catch all reasons for the cell size to change, but it might be a better tradeoff than a Refresh[...,UpdateInterval->0.1] style solution.
$\endgroup$
1
  • $\begingroup$ Very instructive, thank you! I just found that AbsoluteCurrentValue[PreviousCell[], CellSize] works when the PreviousCell[] contains the output of Pane["", ImageSize -> Full] (and it also is off by 4 printer's points!). $\endgroup$ Commented Aug 7, 2022 at 15:36
4
$\begingroup$

Update 2

In the Wolfram Resource System now is available ResourceFunction["CellBoundingRectangle"] which can be used to determine the width of the contents of a cell as follows.

First, produce an output cell:

expr = Expand[(a + b)^20];
TraditionalForm[expr]

Get the current absolute wrapping width of the output cell using the syntax First@CellBoundingRectangle[cellObj, Full, ImageSize], and specify it as ImageSize for Pane, in order to reproduce the current wrapping independently of the WindowSize:

wrappingWidth = 
  First@CellBoundingRectangle[PreviousCell[CellStyle -> "Output"], Full, ImageSize]
TraditionalForm@Pane[expr, ImageSize -> wrappingWidth]

screesnhot


Update

I found even simpler way to determine the width of the contents of the "Output" cell, which doesn't require creating a new Notebook.

Setting the second argument of FrontEnd`UndocumentedBoxInformationPacket to False results in that it will return information only for current selection in the Notebook. Hence we can get the required information as follows:

cellAreaWidth = Module[{co, width},
 CellPrint[TextCell[Graphics[{}, ImageSize -> {Full, 1}, PlotRangePadding -> None], 
   "Output", CellTags -> "CellAreaWidth", CellOpen -> False]];
 co = First@Cells[CellTags -> "CellAreaWidth"]; 
 SelectionMove[co, All, Cell, AutoScroll->False]; 
 width = FirstCase[
   MathLink`CallFrontEnd[FrontEnd`UndocumentedBoxInformationPacket[co, False]], 
   FE`CellWrapper[{__, FE`BoundingRectangle -> {{xmin_, _}, {xmax_, _}}, ___}] :> 
    xmax - xmin];
 NotebookDelete[co];
 width]

Original answer

Thanks to this informative answer by Silvia, now I have figured out how to obtain the required information without any "magic" numbers.

First, create a Notebook containing an "Output" cell with the output of Graphics[{}, ImageSize -> Full, PlotRangePadding -> None] as the first cell in a cell group:

nb = CreateDocument[{
    CellGroup[
     {ExpressionCell[Graphics[{}, ImageSize -> Full, PlotRangePadding -> None], 
       "Output"],
      ExpressionCell["", "Output"]}]},
   WindowSize -> AbsoluteCurrentValue[EvaluationNotebook[], WindowSize], 
   Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator], CellGrouping -> Manual, 
   Magnification -> CurrentValue[EvaluationNotebook[], Magnification], Visible -> False];

Now get the width of the contents of the first cell as

cellAreaWidth = FirstCase[
  MathLink`CallFrontEnd[
   FrontEnd`UndocumentedBoxInformationPacket[nb]],
  FE`CellWrapper[
    {__, FE`BoundingRectangle -> {{xmin_, ymin_}, {xmax_, ymax_}}, ___}] :> xmax - xmin]

For Magnification -> 1 this code returns exactly the same number as the code in my previous answer (after subtracting the "magic" number 4).

Do not forget to close created Notebook:

NotebookClose[nb]

screenshot

$\endgroup$
3
$\begingroup$

Currently I've developed the following solution, which seems to work perfectly with Mathematica 12.3.1 and 13.1.0 on Windows 10 x64. However, I still don't understand from where comes the "magic number" 4 pts, which I must subtract from the obtained width in order to achieve the perfect match. The value 4 was found for Maginification -> 1, and depends on the Maginification setting in an unobvious way. Also, this value can be version- and OS-specific. It is also strange that without PlotRangePadding -> None the code sometimes returns slightly different value.

cellAreaWidth = 
  First@Cases[
    FrontEndExecute@
     ExportPacket[
      Notebook[{Cell@CellGroupData[{Cell["", "Input"], 
          Cell[BoxData@
            ToBoxes@Annotation[Graphics[{}, ImageSize -> Full, PlotRangePadding -> None], 
              "CellArea", "Region"], "Output"]}]}, 
       WindowSize -> AbsoluteCurrentValue[EvaluationNotebook[], WindowSize], 
       Evaluator -> CurrentValue[EvaluationNotebook[], Evaluator]], "BoundingBox", 
      Verbose -> True], {{"CellArea", "Region"}, {{xmin_, xmax_}, {ymin_, ymax_}}} :> 
     xmax - xmin, 3];

lst = ResourceFunction["CreateSortableUniqueID"][20]

Pane[lst, ImageSize -> {cellAreaWidth - 4, Automatic}, 
 ImageSizeAction -> "ShrinkToFit", FrameMargins -> None]

screenshot

$\endgroup$
0
$\begingroup$

Since currently the method demonstrated by Lukas Lang is the only documented and straightforward way to get the current cell width (with some "magic" offset), let us investigate how it is related to the Magnification and to the actual cell width returned by FrontEnd`UndocumentedBoxInformationPacket.

First, define an auxiliary function:

cellWidth[cell_CellObject] := (SelectionMove[cell, All, Cell, AutoScroll -> False];
  FirstCase[
   MathLink`CallFrontEnd[
    FrontEnd`UndocumentedBoxInformationPacket[ParentNotebook@cell, False]], 
   FE`CellWrapper[{__, FE`BoundingRectangle -> {{xmin_, _}, {xmax_, _}}, ___}] :> 
    xmax - xmin])

Next, create a tagged cell containing the output of Pane["", ImageSize -> {Full, Automatic}]:

CellPrint[ExpressionCell[Pane["", ImageSize -> {Full, Automatic}], "Output", 
  CellTags -> "cellsize"]]

With this setup, find out how cellWidth and CellSize depend on Magnification (output is from Mathematica 13.1.0 on Windows 10 x64):

cellObj = First[Cells[CellTags -> "cellsize"]];
lst = Table[SetOptions[EvaluationNotebook[], Magnification -> i]; Pause[.1]; 
  {i, cellWidth[cellObj],
   AbsoluteCurrentValue[cellObj, CellSize][[1]]}, {i, .3, 6, .1}]
SetOptions[EvaluationNotebook[], Magnification -> 1]
ListPlot[{lst[[All, {1, 2}]], lst[[All, {1, 3}]]}, Frame -> True, 
 FrameLabel -> {Magnification, "Width, printer's points"}, 
 PlotLegends -> {"cellWidth", "CellSize"}]
{{0.3,1862.45,6221.5},{0.4,1854.85,4647.13},{0.5,1847.25,3702.5},{0.6,1839.65,3072.75},{0.7,1832.05,2622.93},{0.8,1824.45,2285.56},{0.9,1816.85,2023.17},{1.,1809.25,1813.25},{1.1,1801.65,1641.5},{1.2,1794.05,1498.38},{1.3,1786.45,1377.27},{1.4,1778.85,1273.46},{1.5,1771.25,1183.5},{1.6,1763.65,1104.78},{1.7,1756.05,1035.32},{1.8,1748.45,973.583},{1.9,1740.85,918.342},{2.,1733.25,868.625},{2.1,1725.65,823.643},{2.2,1718.05,782.75},{2.3,1710.45,745.413},{2.4,1702.85,711.188},{2.5,1695.25,679.7},{2.6,1687.65,650.635},{2.7,1680.05,623.722},{2.8,1672.45,598.732},{2.9,1664.85,575.466},{3.,1657.25,553.75},{3.1,1649.65,533.435},{3.2,1642.05,514.391},{3.3,1634.45,496.5},{3.4,1626.85,479.662},{3.5,1619.25,463.786},{3.6,1611.65,448.792},{3.7,1604.05,434.608},{3.8,1596.45,421.171},{3.9,1588.85,408.423},{4.,1581.25,396.313},{4.1,1573.65,384.793},{4.2,1566.05,373.821},{4.3,1558.45,363.36},{4.4,1550.85,353.375},{4.5,1543.25,343.833},{4.6,1535.65,334.707},{4.7,1528.05,325.968},{4.8,1520.45,317.594},{4.9,1512.85,309.561},{5.,1505.25,301.85},{5.1,1497.65,294.441},{5.2,1490.05,287.317},{5.3,1482.45,280.462},{5.4,1474.85,273.861},{5.5,1467.25,267.5},{5.6,1459.65,261.366},{5.7,1452.05,255.447},{5.8,1444.45,249.733},{5.9,1436.85,244.212},{6.,1429.25,238.875}}

plot

We see that while cellWidth depends linearly on Magnification, for CellSize the dependence is purely hyperbolic:

ListPlot[{1/#1, #3} & @@@ lst, Frame -> True, 
 FrameLabel -> {1/Magnification, "Width, printer's points"}, PlotLegends -> {"CellSize"}]

plot

FindFormula[{1/#1, #3} & @@@ lst]
-76. + 1889.25 #1 &

Apparently, the offset -76. comes from CellMargins:

Total@AbsoluteCurrentValue[
   EvaluationNotebook[], {StyleDefinitions, "Output", CellMargins}][[1]]
76

Let us find the formula for cellWidth:

FindFormula[lst[[All, {1, 2}]]]
1885.25 - 76. #1 &

Here we have the known coefficient -76. and the offset 1885.25, which is exactly 4 pts smaller than the coefficient 1889.25 in the formula for CellMargins.

Apparently, cellWidth and CellSize are related by the relation:

AbsoluteCurrentValue[cellObj, CellSize][[1]]*AbsoluteCurrentValue[Magnification] == 
 cellWidth[cellObj] + 4

It remains only to understand where the values 1885.25 and 1889.25 come from.

Experimentation shows that CellMargins depend on "Margins" and "Widths" suboptions of CellBracketOptions, but doesn't depend on the "Thickness" suboption, and the formula in our case is as follows:

zeroCellWidth - (leftMargin + rightMargin + leftWidth + 2*rightWidth)

where 2 is the number of cell brackets (our cell is grouped with input cell). Here is a checkup with random settings for CellBracketOptions:

SetOptions[cellObj, 
  CellBracketOptions -> {"Margins" -> {0, 0}, "Thickness" -> 0, "Widths" -> {0, 0}}];
zeroCellWidth = AbsoluteCurrentValue[cellObj, CellSize][[1]];
And @@ Table[
  {leftMargin, rightMargin, leftWidth, rightWidth, thickness} = RandomReal[{0, 100}, 5];
  SetOptions[cellObj, 
   CellBracketOptions -> {"Margins" -> {leftMargin, rightMargin}, 
     "Thickness" -> thickness, "Widths" -> {leftWidth, rightWidth}}];
  AbsoluteCurrentValue[cellObj, CellSize][[1]] ==
   zeroCellWidth - (leftMargin + rightMargin + leftWidth + 2 rightWidth), {100}]
True

In more complicated cases, when we have a deeper nesting, the following formula works (at least, with the default stylesheet):

zeroCellWidth - (leftMargin + rightMargin + n*leftWidth + (n+1)*rightWidth)

where n is the number of enclosign CellGroups containing the Cell of interest.

Further experiments show that zeroCellWidth for frameless window is equal to window width from WindowSize minus (leftCellMargin + rightCellMargin - 10), and the window frame with all elements in my case has width 24.75 pts:

windowWidth = AbsoluteCurrentValue[EvaluationNotebook[], WindowSize][[1]]
SetOptions[cellObj, 
  CellBracketOptions -> {"Margins" -> {0, 0}, "Thickness" -> 0, "Widths" -> {0, 0}}];
SetOptions[cellObj, CellMargins -> {{66, 10}, {0, 0}}];
zeroCellWidth = AbsoluteCurrentValue[cellObj, CellSize][[1]]
SetOptions[EvaluationNotebook[], WindowFrame -> "Frameless", WindowFrameElements -> {}, 
  WindowElements -> {}];
framelessZeroCellWidth = AbsoluteCurrentValue[cellObj, CellSize][[1]]
SetOptions[EvaluationNotebook[], WindowFrame -> Inherited, 
  WindowFrameElements -> Inherited, WindowElements -> Inherited];
windowWidth - framelessZeroCellWidth
zeroCellWidth - framelessZeroCellWidth
1920.

1829.25

1854.

66.

-24.75

The last value 24.75 pts seems to be too high, because a simple pixel count in the screenshots shows that the vertical scrollbar, including the frame, is 17 pixels wide, and the frame itself is 1 pixel wide. Translating this to printer's points, we get:

18*72./96
13.5

This is what should be expected as the value for the width of window frame with all its elements.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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