How do I make those nice summary boxes like Dispatch and SparseArray do?

Question

Dispatch and SparseArray have nice output forms that summarise their contents:

The contents even manage to be retained fully on copy/paste. How can I make this happen for my own symbols?

Answer 1

If you want to make a nice neat way of displaying a thing with Head head, the following will work (thanks to Sjoerd):

head /: Format[b : head[a_Association]] := 
 RawBoxes[
  BoxForm`ArrangeSummaryBox[
   "NiceHeadName",
   b, 
   Graphics3D[Cone[], ImageSize -> 20],
   {BoxForm`MakeSummaryItem[{"Summary 1: ", a["sum1"]}, StandardForm], 
    BoxForm`MakeSummaryItem[{"Summary 2: ", a["sum2"]}, StandardForm]}, 
   {BoxForm`MakeSummaryItem[{"Expanded thing 1: ", a["sumhidden1"]}, StandardForm], 
    BoxForm`MakeSummaryItem[{"Expanded thing 2: ", a["sumhidden2"]}, StandardForm], 
    BoxForm`MakeSummaryItem[{"Expanded thing 3: ", a["sumhidden3"]}, StandardForm]},
   StandardForm]
 ];

If you give a definition as

head[
 <| "sum1" -> 10, "sum2" -> "Hi!",
    "sumhidden1" -> 1, "sumhidden2" -> 2, "sumhidden3" -> Pi
 |>
]

then the output (shown twice, once non-expanded in the Out cell and once expanded in the next In cell) is:

Moreover, this object has the same FullForm as the original: you can copy and paste it, and it'll still work fine. In particular, though it appears to have Head NiceHeadName, it actually still has Head head, just as required.